APPENDIX A 



Smalltalk defineClass: #AbstractParticipantProcess 
superclass: #{ Core. Object} 
indexedType: #none 
private: false 

instanceVariableNames: 'myld ' 
classInstanceVariableNames: " 
imports: " 
category: "! 



lAbstractParticipantProcess methodsFor: 'accessing'! 
host 

A SocketAccessor getHostname! 

myld 

A myld! 



lAbstractParticipantProcess methodsFor: *ui support'! 
statusString 

self subclassResponsibility.! 



Smalltalk defineClass: #ParticipantProcess 
superclass: #{AbstractParticipantProcess} 
indexedType: #none 
private: false 

instanceVariableNames: 'usp executionProcess outboundChannels outputBuffers session ' 
classInstanceVariableNames: " 
imports: " 
category: "! 

IParticipantProcess methodsFor: 'accessing - log'! 
at: indent log: aString 

USPControllerService current at: indent log: aString.! 

i 



!ParticipantProcess methodsFor: 'private-execution'! 
deleteJobsFromBuffer: outBuff forChannel: outChan 

[outChan isEmpty] whileFalse: [ 
| deletionCount | 

deletionCount := outBuff deleteJobsUpTo: outChan next. 
selfat:01og: 

self myld printString, ': deleted ', deletionCount printString, 
'jobs previously sent to #', outChan remoteld printString].! 

executionLoop 

"Execute me forever (or until stopped by another process). This runs in a background process, 
so use my session to allow use of the miosoft user interface while it's running." 

self subclassResponsibility.**-. 

! Partic ipantProcess methodsFor: 'initialize-release'! 
initializeForlndex; anlnteger 

"Does not need to be called within a transaction." 

myld := anlnteger. 

session := OoSession open: 'currentdbV 

session rpcTimeout: 5000; uselndex: true; recover: false. 

session transactionMROW: [ 

self initialize WithinTransaction].! 

i 
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IParticipantProcess methodsFor: 'private-initialization'! 
initializeWithinTransaction 

"Only called within a transaction (of my session)." 

usp := UpdateStreamProcessor named: 'Main' inSession: session. 
outboundChannels := Array new: usp numberOflContentionSpaces. 

selfsetupOutboundChannels.! 



IParticipantProcess methodsFor: 'testing'! 
isLocal 

A true! 



!ParticipantProcess methodsFor: 'accessing'! 
numberOflContentionSpaces 

"outboundChannels size! 



IParticipantProcess methodsFor: 'private-outbound 1 ! 
setupOutboundChannels 

"Must be in transaction, preferrably MROW." 

1 to: outboundChannels size do: [:i | 
| channel | 

channel := JobChannel new. 
channel myld: myld. 
channel socket: nil. 
channel remoteld: i. 
outboundChannels at: i put: channel].! 

i 



! Panic ipantProcess methodsFor. 'controlling'! 
start 

executionProcess notNil ifTrue: [ A selfJ. 
executionProcess := Process 

forBlock: [self execution Loop] 

priority: Processor userSchedulingPriority - 3. "user interaction takes precedence." 
executionProcess resume.! 



IPI 

(p := executionProcess) notNil ifTrue: [p terminate]. 
executionProcess := nil 

outboundChannels do: [xh | ch notNil ifTrue: [ch stop]].! 



Smalltalk defineClass: #ContenttopSpaceProcess 

superclass: #{ParticipantProccss} 
indexedType: #none > 
private: false . 

instanceVariableNames: 'contentionSpace listenerProcess HstenProtect inboundChannels readyJobs runningJob runningTag groupsByTag indexedWaiters 
currentGroup createdJobList pleaseCommitTimer memento lastGC idleDeletionDelay previouslnbounds affected Inbounds ' 
classInstanceVariableNames: " 
imports: " 
category: M ! 



2 



!ContentionSpaceProcess methodsFor: 'accessing'! 
addJob: aJob 

"This is the entry point used by jobs already executing within my executionLoop. It allows them to 
add new jobs safely and efficiently." 

aJob checkContentionSpace." "safety" 
aJob oolsPersistent ifTrue: [ 

self error: 'Jobs to be transmitted must not be persistent']. 
aJob originatorlndex: my Id. 
created JobList add: aJob.! 



!ContentionSpaceProcess methodsFor: 'private-execution'! 
addWaitingJob: aJob 

"Given a job, add it to the parallel ordered collections indexedWaiters (transient) and waitingSyncJobs 
(persistent). Do this by tacking the job onto the end of these collections. Answer the index->job pair 
that was added to indexedWaiters." 

| index assoc | 

aJob assertType: Job. 

index := indexedWaiters size + 1 . 

[index = (contentionSpace waitingSyncJobs size + 1)] assert, 
assoc := index -> aJob. 
indexedWaiters addLast: assoc. 
contentionSpace waitingSyncJobs addLast: aJob. 
A assoc! 

col lapse IfNecessary: indexedJobs 

"Given a collection of index->Job pairs, ask each job if it wants to collapse. If the job answers nil, ask the 
next job. If all jobs answer nil, return the original collection indexedJobs. Otherwise one of the jobs has 
answered a new job to use in place of the collection. Delete the given jobs and insert the new job (which 
must have the same synchronization tag as all given jobs) into the indexedWaiters and waitingSyncJobs 
collections. Answer a collection with just newIndex->newJob in it in that case." 

| jobs | 

jobs :« indexedJobs collect: [:assoc | assoc value], 
jobs do: [:job | 

| collapsed collapsedAssoc | 
collapsed := job collapseJobs: jobs, 
collapsed notNil ifTrue: [ 

"A collapse has been requested by one of the jobs." 

collapsed assertType: Job. 

[jobs all: [:j | j — collapsed]] assert. 

collapsed 

originatorlndex: 0; 
jobld: 0; 
tag: job tag. 

"Remove the old jobs first..." 
indexedJobs do: [:job Assoc | 

self remove WaitingJobAssoc: jobAssoc. 

jobAssoc value oolsPersistent ifTrue: [ 
jobAssoc value ooDelete]]. 
collapsedAssoc :- self addWaitingJob: collapsed. 
A OrderedCollection with: collapsedAssoc]]. 

"All the jobs agree that collapsing is not appropriate." 

A indexedJobs! 'jlff"^'' 



!ContentionSpaceProcess methodsFor: 'execution tuning'! 
deletionRequestGranularity 

"Answer approximately how many jobs should be executed (from one source) before 

bothering to tell the source that it may now delete them." 

A 1000 "jobs"! 
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!ContentionSpaceProcess methodsFor: 'private-execution 1 ! 
executionLoop 

"Execute me forever (or until stopped by another process). This runs in a background process, 
so use my private session to allow use of the miosoft user interface while it's running." 

"Reconstruct the transient data structures from the persistent data." 
self recover. 



lastGC := Time millisecondClockValue. 
[ "repeat" 

| starts stops steps lastCommit anyJobs Ready jobsToSend indexOrder | 
starts := stops :- steps := 0. 

pleaseCommitTimer := Delay forMilliseconds: self targetTransactionTime. 
pleaseCommitTimer startup. 
lastCommit := Time millisecondClockValue. 
ObjectMemory quickGC. 
session transactionMROW: [ 
[ 

createdJobList := OrderedCollection new. 

"Process the jobs that are ready." 
readyJobs size > 0 ifTrue: [ 

self at: 0 log: ' (', readyJobs size printString, ' jobs ready, ', 
indexedWaiters size printString, 'jobs waiting to sync)']. 

t 

"Ensure we have a (started) job in runningJob, grabbing (and starting) one if necessary from the 
currentGroup, or if that is empty then from readyJobs." 
(runningJob = nil and: [currentGroup isEmpty]) ifTrue: [ 

runningTag := nil]. 
(runningJob = nil and: [currentGroup notEmpty]) ifTrue: [ 

"Grab jobs from currentGroup first. This is a synchronization group that was activated 

when the final synchronized job of a group was consumed from readyJobs." 

| job Assoc | 

jobAssoc := currentGroup removeFirst. 
runningJob := jobAssoc value, 
starts := starts + I . 
memento := runningJob start, 
self remove WaitingJob Assoc: jobAssoc. 
[runningTag = runningJob tag] assert]. 
[runningJob = nil and: [readyJobs notEmpty]] whileTrue: [ 
| delta | 

[currentGroup isEmpty] assert. 
runningJob := readyJobs removeFirst. 

delta := runningJob job Id - (self lasUobExecutedFrom: runningJob originatorlndex) bitAnd: 16rFFFFFFFF. 
delta = 1 

ifTrue: [ 

runningTag isNil 
ifTrue: [ 

"A job from the readyJobs list." 
runningJob tag isNil 
ifTrue: [ 

"A non-synchronized job from the readyJobs list." 
starts := starts + 1 . 
memento :- runningJob start] 
ifFalse: [ 

r "A synchronized job from the readyJobs list." 

| assoc pair | 

f^fe" 1 assoc := self addWaitingJob: runningJob. 

Cip 2 "-" pair ~ groupsByTag at: runningJob tag ifAbsentPut: [0 -> OrderedCollection new]. 

pair key: pair key + runningJob quorumFraction. 
pair value add: assoc. 
self registerAsConsumed: runningJob. 
pair key =1 
ifTrue: [ 

"The last job of a synchronized group just arrived. Start executing the group.' 

pair value: (self collapselfNecessary: pair value). 

currentGroup := pair value. 

groupsByTag remove Key: assoc value tag. 

assoc := currentGroup removeFirst. 

self remove WaitingJobAssoc: assoc. 

runningJob := assoc value. 

runningTag := runningJob tag. 

starts := starts + 1 . 

memento := runningJob start] 
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ifFalse: [ 

"Wait for the other synchronizing jobs to show up." 
runningJob := nil]]] 

ifFalse: [ 

"The job was taken from currentGroup, so just start executing it." 

starts := starts + 1 . 

memento := runningJob start]] 

ifFalse: [ 

[delta = 0 or: [delta > 1 6r80000000]] assert: 'Bug « job is out of order 1 . 

"This was a retransmitted job (due to a disconnect/restart). We must ignore it." 

runningJob := nil]. 

]• 

pleaseCommitTimer inProgress not or: [runningJob ~ nil] 
] whileFalse: [ 

"Run this job to completion or until a commit is desired." 
( 

pleaseCommitTimer inProgress not or: [runningJob atEnd: memento] 
] whileFalse: [ 

steps := steps + 1 . 

memento := runningJob step: memento withScheduler: self. 

)' 

(runningJob atEnd: memento) ifTrue: [ 

runningJob finish: memento withScheduler: self, 
stops := stops + 1 . 

memento := "bogosity'. "nobody will see this value" 

runningJob tag isNil ifTrue: [ 

"Tagged jobs were already registered as consumed when they were taken from the 
readyJobs list, examined, and added to the (persistent) synchronized job data structures." 
self register AsConsumed: runningJob]. 

runningJob oolsPersistent ifTrue: [runningJob ooDelete]. 

runningJob := nil]. 
]. "while there are jobs" 

"Update the persistent objects in preparation for the upcoming commit." 
createdJobList do: [:job | 

(outputBuffers at: job contentionlndex) addJob: job]. 
jobsToSend := outputBuffers collect: [:buff j 

buff prepareToCommit]. 
runningTag := runningJob isNil ifTrue: [nil] ifFalse: [runningJob tag]. 
contentionSpace runningJob: runningJob. 
contentionSpace runningTag: runningTag. 
self at: 0 log: '[committing {', 

starts printString, ' starts, \ 

steps printString, ' steps, \ 

stops printString, * stops = 

(starts + stops / 2.0) printString, ' jobs @ \ 

(((starts + stops / 2.0) / (Time millisecondClockValue - lastCommit) * 10000.0) rounded / 10.0) printString, 1 jobs/s}...'. 
anyJobsReady := runningJob notNil or: [currentGroup size > 0 or: [readyJobs size > 0]]. 
] valueOnUnwindDo: [session succeed: false]. 
]. "end transaction" 

self at: 1 log: 'done, sending ', (jobsToSend collect: [:x | x size]) sum printString, 'jobs...'. 
pleaseCommitTimer disable. 

indexOrder := (1 to: jobsToSend size) asSortedCollection: :i2 | 

"Simple trick, but it tends to randomize the order that output channels get processed." 

(jobsToSend at: il ) size > (jobsToSend at: i2) size]. 
indexOrder do: [:i | 

(outboundChannels at: i) nextPutAll: (jobsToSend at: i)]. 
self at: 1 log: 'done, sending replies...'. 

self transmitDeletion^ithGranularity: self deletionRequestGranularity. 
self at: I log: 'done] 1 . Ife 

(Time millisecondClockValue between: lastGC and: lastGC + self forcedGarbageCollectFrequency) ifFalse: [ 
"Force garbage collect every few minutes." 
ObjectMemory garbageCollect. 
lastGC :- Time millisecondClockValue]. 

self waitForJobsAndDoMaintenance. 

] repeat.! 
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!ContentionSpaceProcess methodsFor: 'execution tuning" ! 

forcedGarbageCollectFrequency 

"Answer the approximate number of milliseconds we should wait before forcing a 
garbage collection. We only force these garbage collects because (1) the incremental 
collector depends on usct activity, and (2) the generational scavenger tenures pretty 
much every job that we receive, long before we have a change to execute it (and then 
let it go). These forced GC's allow our growth regime bound to be set fairly high (based 
on actual ram) without expecting to actually reach it in normal use." 

A 120000"ms, = 2 minutes"! 



IContentionSpaceProcess methodsFor: 'private-initialization'! 
initial izeWithinTransaction 

"Only called within a transaction (of my session)." 

super initialize WithinTransaction. 
listenProtect :- Semaphore forMutualExclusion. 
contentionSpace := usp participantAt: myld. 
inboundChannels := Array new: usp numberOfParticipants. 

self setupListenerProcess.! 

i 



!ContentionSpaceProcess methodsFor: 'private-execution*! 
lasUobExecutedFrom: originatorlndex 

"Answer the id of the job from the given contention space that has most recently executed." 

Contention Space lasUobsExecuted at: originatorlndex! 
lasUobExecutedFrom: originatorlndex is: anlnteger 

"Set the most recent job id from the given contention space that has executed." 

contentionSpace lasUobsExecuted at: originatorlndex put: anlnteger! 



IContentionSpaceProcess methodsFor: 'private-inbound'! 
HstenerLoopForSocket: socket 

t 

[ 

| conn channel newld | 

self at: 3 log: "Waiting for connection...'. 

socket readWait. 

self at: 4 log: 'connection is present', 
conn := socket acceptNonBlock. 
conn isNil 
ifTrue: [ 

self at: 4 log: 'false alarm - not connected'. 
(Delay forSeconds: 2) wait] 
ifFalse: [ 

self at: 4 log: 'connection is from host ', conn getPeer hostName. 

channel := JobChannel new. 

channel myld: myld. 

channel remoteld: 'Unknown'. 

channel socket: conn. 

channel onConnect: [:chan | 

| oldChannel | 

[chan = channel] assert. 

self at: 4 log: 'connection from \ chan remoteld printString, ' is established', 
newld chan remoteld. 
[newld islnteger] assert. 
listenProtect critical: [ 

oldChannel := inboundChannels at: newld. 

inboundChannels at: newld put: chan]. 
oldChannel notNil ifTrue: [oldChannel stop]], 
channel onDisconnect: [xhan | 

self at: 4 log: 'Lost connection from ', newld printString. 
chan stop. 

listenProtect critical: [ 

(inboundChannels at: newld) = chan ifTrue: [ 
inboundChannels at: newld put: nil]]]. 

channel start]. 

] repeat. 
] ensure: [ 

socket close 

].! 



IContentionSpaceProcess methodsFor: 'execution tuning'! 

maximumldleDeletionDelay 

"Answer the maximum time to wait from when a deletion request arrives to when the 
deletion should actually be committed. This only applies when there are no jobs left 
to execute. As soon as a job arrives (assuming I was previously quiescent), we just 
commit the deletion requests right away and start executing." 

A 10000"ms"! 



IContentionSpaceProcess methodsFor: 'accessing*! 
nextUniquelnteger vj* 

"This should only be called jobs running in my executionLoop (and therefore in a non-conflicting transaction)." 

A contentionSpace nextUniquelnteger! 
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!ContentionSpaceProcess methodsFor: 'private-execution'! 
recover 

"Reconstruct the transient data structures from the persistent data." 

IndexEntry initialize. 

session transactionMROW: [ 

outputBuffers := contentionSpace outputBufTers copy. 
"Start up the listener if it was stopped..." 
self setupListenerProcess. 

"Recovery - resend all outbound jobs. First process the deletion requests to reduce the 
amount of useless information we're resending." 
outboundChannels with: outputBuffers do: [:outChan :outBuff| 

outChan reestablishlfNecessaryFor: usp. 

self deleteJobsFromBuffer: outBuffforChannel: outChan. 

outChan was Recovered ifTrue: [ 

outBuff retransmitAllViaChannel: outChan]]. 
readyJobs := OrderedCol lection new. 
runningJob := contentionSpace runningJob! 
runningTag := contentionSpace runningTag. 
currentGroup :- OrderedCollection new. 
groupsByTag := Dictionary new. 
indexed Waiters := OrderedCollection new. 
contentionSpace waitingSyncJobs keysAndValuesDo: [:i job | 

| assoc pair | 

[job — runningJob] assert, 
assoc := i -> job. 
job tag - runningTag iff rue: [ 
currentGroup add: assoc]. 
indexedWaiters addLast: assoc. 
[indexedWaiters size = i] assert. 

pair := groupsByTag at: job tag ifAbsentPut: [0 -> OrderedCollection new]. . 

pair key: pair key + job quorumFraction. 

[pair key < I ] assert. 

pair value add: assoc]. 
runningJob = nil 

ifTrue: [memento := nil] 

ifFalse: [memento := runningJob restart], 
previouslnbounds := (1 to: inboundChannels size) collect: [:i | 

self lasUobExecutedFrom: ij. 
affectedlnbounds := previouslnbounds copy. 

V 

registerAsConsumed: aJob 

"Record the fact that this job has been 'completed'. For a non-synchronizing job, this means the 
job really has finished executing. For a synchronizing job it means the job's essence has been 
recorded persistently locally (and is therefore recoverable). Note that we can't immediately send 
a message back to the originator, but instead must wait until we've committed this job's effect." 

[(aJob jobld - (self lasUobExecutedFrom: aJob originatorlndex) bitAnd: 16rFFFFFFFF) = 1] assert, 
self lasUobExecutedFrom: aJob originatorlndex is: aJob jobld. 
affectedlnbounds at: aJob originatorlndex put: aJob jobld. 
(previouslnbounds at: aJob originatorlndex) isNil ifTrue: [ 

previouslnbounds at: aJob originatorlndex put: aJob jobld - 1].! 
remove WaitingJobAssoc: jobAssoc? 

"Given an index->Job pair,TCTnpye this job from the parallel ordered collections indexedWaiters 
(transient) and waitingSyn|SSK r Q3«rsistent). Do this by moving the last job into the hole that 
would be left by removingi|Bf designated job." 

| lastAssoc | 

lastAssoc ~ indexedWaiters last. 

[lastAssoc value — contentionSpace waitingSyncJobs last] assert. 

[jobAssoc value — (contentionSpace waitingSyncJobs at: jobAssoc key)] assert. 

indexedWaiters 

at: jobAssoc key put: lastAssoc; 

remove Last. 
contentionSpace waitingSyncJobs 

at: jobAssoc key put: lastAssoc value; 

remove Last. 
lastAssoc key: jobAssoc key.! 
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IContentionSpaceProcess methodsFor: 'accessing'! 
session 

A session! 



IContentionSpaceProcess methodsFor: "private-inbound*! 
setup L .i stenerProcess 

"This must be inside a transaction. Update the ContentionSpace's host and port information once 
the socket is ready to connect to." 

| port socket | . 

listenerProcess notNil ifTrue: [ A self|. 

port := contentionSpace port. 
I 

socket := SocketAccessor newTCPserverAtPort: port. 
] on: OSErrorHolder existingReferentSignal do: [:ex | 
"Scan for a free port to use." 
port := port + 1 . 

port > IPSocketAddress maxPort ifTrue: [port := IPSocketAddress firstUnreservedPort]. 
ex retry], 
[socket notNil] assert. 

"Let everyone know (via eventual polling) which port to connect to." 
socket listenFor: contentionSpace numberOfParticipants. 
contentionSpace setHostName: SocketAccessor getHostname port: port. 
listenerProcess := Process 

forBlock: [self HstenerLoopForSocket: socket] 

priority: Processor userSchedulingPriority - 1 . 
listenerProcess resume.! 



IContentionSpaceProcess methodsFor: 'ui support'! 
statusString 

|str| 

str := WriteStream on: (String new: 64). 
listenerProcess notNil ifTrue: [strnextPutAll: 'Listening, ']. 
executionProcess notNil ifTrue: [strnextPutAll: 'Running, ']. 
strnextPutAll: 'IN='. 
inboundChannels do: [:in | 
StrnextPutAll: ( 

in isNil ifTrue: ['-'] ifFalse: [ 

in hasFirmConnection ifTrue: ['+•] ifFalse: ['?']])]. 
str nextPutAll: OUT=\ 
outboundChannels do: [:out | 
str nextPutAll: ( 

out isNil ifTrue: ['-'] ifFalse: [ 

out hasFirmConnection ifTrue: ['+'] ifFalse: ['?']])]. 

A str contents! 



IContentionSpaceProcess methodfl^n •controlling'! 

st °P MZ^ / 

IPI 

(p :- listenerProcess) notNil ifTrue: [p terminate). 
listenerProcess :« nil. 
super stop. 

inboundChannels do: [:ch | ch notNil ifTrue: [ch stop]]. 
inboundChannels := Array new: inboundChannels size. 
createdJobList := nil.! 
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IContentionSpaceProcess methodsFor: 'execution tuning'! 
targetTransactionTime 

"Answer the 'ideal' length of a transaction in milliseconds. When executing jobs, if we notice 
this amount of time has expired, we force a commit even if there are more jobs ready to run." 

"5000 "ms"! 
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IContentionSpaceProcess mcthodsFor: 'private-execution'! 
transmitDeletionsWithGranularity: granularity 

! to: affectedlnbounds size do: [:i | 
| previousLastld lasUobld | 
previousLastld := previouslnbounds at: i. 
lasUobld := affectedlnbounds at: i. 

(lastlobld notNil and: [lasUobld -= previousLastld]) ifTrue: [ 
I in i 

(lasUobld // granularity) « (previousLastld // granularity) ifFalse: [ 

"Send a deletion request if we crossed the granularity boundary (or a rollover) 
for the completed jobs." 
in :- inboundChannels at: i. 
in notNil ifTrue: [ 

previouslnbounds at: i put: lasUobld. 
innextPut: lasUobld]]]].! 
waitForJobsAndDoMaintenance 

"Wait for jobs to arrive along my inboundChannels. Until some arrive, process job-deletion messages 
and attempt to reestablish channels if needed." 

[ "whileTrue:" 

| pollingPause | 
pollingPause := 1 0. "ms" 
session transactionMROW: [ 
| hasDeleted timerExpired | 

self at: 0 log: self myld printString, ': looking for jobs etc.'. 
idleDeletionDelay := Delay forMilliseconds: self maximumldleDeletionDelay. 
idleDeletionDelay startup. 
hasDeleted := false. 
[ 

"Process all deletion requests." 

outboundChannels with: outputBuffers do: [:outChan :outBuff | 
outChan reestablish IfNecessary For: usp. 
[outChan isEmpty] whileFalse: [ 
hasDeleted ifFalse: [ 

"Capture the time at which the first delete happens." 
idleDeletionDelay disable; startup. 
hasDeleted := true], 
self deleteJobsFromBuffer: outBuffforChannel: outChan]]. 
"Deal with incoming jobs." 
inboundChannels do: [:inChan | 
inChan notNil ifTrue: [ 

[inChan isEmpty] whileFalse: [ 

readyJobs add: (inChan nextUsingSession: session)]]]. 
"Now check to see if any connections have been re-established (and therefore need 
their jobs re-sent)." 

outboundChannels with: outputBuffers do: [:outChan :outBuff | 
outChan wasRecovered ifTrue: [ 

outBuffretransmitAHViaChannel: outChan]]. 

timerExpired := idleDeletionDelay inProgress not. 
timerExpired ifTrue: [ 

"It's been a while since any jobs, or even deletion requests have arrived. Now's a 

good time to send out a *precise* deletion request for those few jobs for which I've 

executed them but I haven't told their originators yet." 

self transmitDeletionsWithGranularity: 1]. 
"Commit tte|*nsacu on whenever either: 

(A) tiiS^ajc jobs ready, or 

(B) a deletion request was processed more than N seconds ago." 
readyJobs notEmpty or: [ 

- hasDeleted and: [timerExpired]] 
] whileFalse: [ 

(Delay forMilliseconds: pollingPause) wait. 

pollingPause := pollingPause * 2 min: 1000. "Back off to leave some CPU for other OS processes." 

]• 

]• 

readyJobs isEmpty 
] whileTrue: [].! 
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Smalltalk defineCiass: #ProducerProcess 
superclass: #{ParticipantProcess} 
indexedType: #none 
private: false 

instanceVariableNames: 'sessionLock jobQueue ' 
classlnstanceVariableNames: " 
imports: " 
category: "! 



IProducerProcess methodsFor: 'accessing'! 
addJob: aJob 

aJob checkContentionSpace." "safety" 
[aJob oolsPersistent not] assert. 
aJob originatorlndex: myld. 
jobQueue nextPut: aJob.! 
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!ProducerProcess methodsFor: 'private-execution'! 
execution Loop 

"Execute me forever (or until stopped by another process). This runs in a background process, 
so use my session to allow use of the miosoft user interface while it's running." 

self recover. 

[ "repeat" 

| jobsToSend all Jobs check | 

allJobs := OrderedCol lection new: 100. 

[ 

jobQueue isEmpty 
] whileFalse: [ 

all Jobs add: jobQueue next. 

]• 

allJobs size > 0 ifTrue: [ 

self at: 0 log: 'DEBUG: allJobs size = \ allJobs size printString]. 
check := outboundChannels any: [:ch | ch shouldCheck]. 
check := check or: [allJobs notEmpty]. 
check 

ifFalse: [ 

"Be CPU-friendly when we're simply maintaining the connections." 
[allJobs is Empty] assert. 
(Delay forSeconds: 2) wait] 
ifTrue: [ 

allJobs isEmpty ifTrue: [(Delay forSeconds: 1) wait]. "Be nice if we're just trying to reconnect." 
self withSessionDo: [:s | 
s transactionMROW: [ 

[ 

"Process all deletion requests." 

outboundChannels with: outputBuffers do: [:outChan :outBuff j 

outChan reestablishlfNecessaryFor: usp. 

outChan was Recovered ifTrue: [ 

outBuff retransmitAHViaChannel: outChan]. 

self deleteJobsFromBuffer: outBuff forChannel: outChan]. 
"Update the persistent objects in preparation for the upcoming commit." 
allJobs do: [:job | 

| buff | 

[job contentionlndex between: 1 and: usp numberOfContentionSpaces] assert. 
bufT :- outputBuffers at: job contentionlndex. 
buff addJob: job]. 
jobsToSend := outputBuffers collect: [:buff | 

buff prepareToCommit]. 
self at: 0 log: 'jobsToSend = \ O'obsToSend collect: [:x | x size]) printString. 
self at: 0 log: '[commit...'. 
] valueOnUnwindDo: [s succeed: false]. 
J. "end transaction" 

]. 

self at: 0 log: '...done, sending jobs...'. 
jobsToSend with: outboundChannels do: [:jobList :outChan | 
jobList size > 0 ifTrue: [ 

self at: 0 log: '{', jobList size printString, 
■ from outChan myld printString, 
' to ', outChan remoteld printString, '}'. 
outChan nextPutAll: jobList]]. 
selfatiOlog^'-done]'. 
]. "...ifTrue" 

] repeat.! 



!ProducerProcess methodsFor: 'initialize-release'! 
initializeForlndex: anlnteger 

"Does not need to be called within a transaction." 

super initializeForlndex: anlnteger. 
sessionLock := Semaphore forMutual Exclusion. 
jobQueue := SharedQueue new.! 
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IProducerProcess methodsFor: "private-execution 1 ! 
recover 

"Reconstruct the transient data structures from the persistent data." 
IndexEntry initialize. 

"The recovery behaviour is to resend all my jobs." 
self withSessionDo: [:s | 
s transactionMROW: [ 

outputBuffers := (usp participantAt: myld) outputBuffers copy. 

"Process old deletion requests (this should reduce the number of jobs needed for recovery)." 
outboundChannels with: outputBuffers do: [.outChan :outBuff | 

outChan reestablishlfNecessaryFor: usp. 

outChan was Recovered ifTrue: [ 

outBuff retransmitAHViaChannel: outChan]. 

self deleteJobsFromBufTer: outBuff forChannel: outChan]]].! 



IProducerProcess methodsFor: *ui suppont'! 
statusString 

i str | 

str := WriteStream on: (String new: 64). 
executionProcess notNil ifTrue: [str nextPutAll: 'Running, ']. 
str nextPutAll: 'OUT=\ 
outboundChannels do: [:out | 
str nextPutAll: ( 

out isNil ifTrue: ['-'] ifFalse: [ 

out hasFirmConnection ifTrue: ['+'] ifFalse: ['?']])]. 

A str contents! 



!ProducerProcess methodsFor: 'accessing'! 
withSessionDo: aBlock 

"Execute the block, passing in the session I use for executing my job-distributing loop. 

Note that the execution process and the process calling this method will mutually 

exclude each other from running." 

sessionLock critical: [aBlock value: session].! 



Smalltalk defineClass: #SaturationTestProducerProcess 

superclass: #{ProducerProcess} 
indexedType: #none 
private: false 

instance VariableNames: " 
classInstanceVariableNames: " 
imports: " 
category: "! 



!SaturationTestProducerProcess methodsFor: 'private-outbound'! 
auto Replenish J obsForSaturationTest: aBoolean 
"Must be in transaction, preferrably MROW." 

1 to: outboundChannels sizfrdo: [:i | 
| channel | ->5i/' 
channel :«■ outboundChannels at: i. 
aBoolean 

ifTrue: [ 

channel jobGenerator: [:n | 

"This block says how to generate more jobs via this channel." 
n timesRepeat: [ 

self addJob: (RandomChangeForSaturationTesUob new 
contentionlndex: channel remoteld; 

productSubscript: (BouncingJob random next * Smalllnteger maxVal) truncated + 1)]]] 
ifFalse: [channel jobGenerator: nil]].! 
currenUobCounts 

"Used for saturation testing." 

A outputBuffers collect: [:ch | ch currenUobCount]! 
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ISaturationTestProducerProcess methodsFor: 'private-execution'! 
del ete Jobs Fro mBuffer: outBuff forChannel: outChan 



| deletionCount | 

deletionCount := 0. 

[outChan isEmpty] whileFalse: [ 

deletionCount := deletionCount + (outBuff del eteJobsUpTo: outChan next)]. 

deletionCount > 0 ifTrue: [ 
self at: 0 log: 

self myld printString, ': deleted and replenishing \ deletionCount printString, 
'jobs previously sent to #', outChan remoteld printString. 

outChan jobGenerator notNil ifTrue: [ 

outChan jobGenerator value: deletionCount]. 



ISaturationTestProducerProcess methodsFor: 'private-outbound'! 
setupOutboundChannels 

"Must be in transaction, preferrably MROW." 

1 to: outboundChannels size do: [:i | 
| channel | 

channel := SaturationTestlobChannel new. 
channel myld: myld. 
channel socket: nil. 
channel remoteld: i. 
outboundChannels at: i put: channel].! 



Smalltalk defineClass: #RemoteProcess 

superclass: # { AbstractParticipantProcess } 
indexedType: #none 
private: false 

instanceVariableNames: *host status ' 
class Instance VariableNames: " 
imports: " 
category: "! 



! RemoteProcess methodsFor: 'accessing'! 
host 

A host! 



(RemoteProcess methodsFor: 'initialize -release'! 
initializeForlndex: anlnteger host: hostString status: statString 
"Does not need to be called within a transaction." 

myld := anlnteger. 
host := hostString. 
status :- statString.! -'-;: 

! 



! RemoteProcess methodsFor: 'testing'! 
is Local 

A false! 



! RemoteProcess methodsFor: 'controlling'! 
start 

USPControllerService current send: 'Start process *, myld printString toHost: host.! 

i 
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'.RemoteProcess methodsFor: 'accessing'! 
status: aString 

status := aString.! 



! RemoteProcess methodsFor: 'ui support 1 ! 
statusString 

A status! 



! RemoteProcess methodsFor: 'controlling'! 
stop 

USPControllerService current send: 'Stop process \ myld printString toHost: host.! 



Smalltalk defineClass: #Job 
superclass: #{Core.Object} 
indexedType: #none 
private: false 
instanceVariableNames: ' 

contentionlndex <uintl6> 

originatorlndex <uintl6> 

jobld <uint32> 

taglnteger <uint64> 

quorumFractionNumerator <uint32> 

quorumFractionDenominator <uint32>' 
class InstanceVariableNames: " 
imports: " 
category: " ! 



!Job class methodsFor: 'instance creation'! 
new 

A super new initialize! 



!Job class methodsFor: 'private: generated'! 
ooCodeGenVersion 



A 1! 

ooTypedlnstanceVariablesString 

contentionlndex <uintl6> 
originatorlndex <uintl6> 
jobld <uint32> 
taglnteger <uint64> 
quorumFractionNumeratpr <uint32> 
quommFractionDenoirraiatOT <uint32>'! 



!Job methodsFor: 'execution'! 
atEnd: memento 

"Answer whether the job has finished stepping. If so, the #finish: message will be sent to it. 
This method is called within a transaction. Normally, this memento was the result of the previous 
execution step, but after a crash, the #restart message is sent to acquire a memento." 

self subclass Responsibility.! 

t 
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!Job methodsFor: 'checking'! 

checkContentionSpace 

"Make sure I'll only access objects in my own contention space. This check can be 
made at any time after the job has been fully initialized, including just prior to execution." 

A selfl 



!Job methodsFor: 'execution'! 
collapseJobs: jobs 

"Given a collection of jobs which includes me. answer either nil or a new 
single job that has the same effect as the given jobs. Each job in the 
collection will be given the chance to collapse, and the first job that replies 
with a collapsed job will be the one that determines how to collapse them. 
Since the jobs are persistent, this is always called within a transaction." 

A nil! 



!Job methodsFor: 'accessing'! 
contentionlndex 

Contention Index! 
contentionlndex: anlnteger 

contentionlndex :- anlnteger.! 



!Job methodsFor: 'execution'! 

finish: memento withScheduler: aJobScheduler 

"The job is finished, so do any final actions necessary. 

This method is called within a transaction." 

[self atEnd: memento] assert, 
"do nothing by default."! 



!Job methodsFor: 'initialize-release'! 
initialize 

taglnteger :* 0. 

quorumFractionNumerator := 1. 
quorumFractionDenominator := 1.! 



!Job methodsFor: 'accessing'! 
jobld 

A jobId! 
jobld: anlnteger 

jobld := anlnteger.! 
originatorlndex 

A originatorlndex! 
originatorlndex: anlnteger 

originatorlndex := anlnteger.! 
quorumFraction 

A quorumFractionNumerator / quorumFractionDenominator! 
quorumFraction: aFraction 

"This fraction represents the portion of a quorum that this job represents. When the 
jobs within a contentionSpace that have the same tag have fractions that add up to 1 , they 
are all allowed to run. A job with a quorum fraction of 1 has no need to synchronize." 

quorumFractionNumerator := aFraction numerator. 
quorumFractionDenominator aFraction denominator.! 

! 
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!Job methodsFor: 'execution'! 
restart 

"The job is restarting after a crash. This method is called within a transaction. Answer 
a memento that will be passed to #atEnd:, #step: withScheduler:, and tffinish: at a later time." 

A nil "the memento"! 

start 

"The job is starting (for the first time, at least as far as what was committed). 
This method is called within a transaction. Answer a memento that will be 
passed to #atEnd:, #step:withScheduler:, and #finish: at a later time." 

A nil "the memento"! 
step: memento withScheduler: scheduler 

"Step the job. If an output row is needed, just ask the scheduler for its currentOutputRow. 
This method is called within a transaction. Answer a new memento to be used in 
successive calls to #atEnd:, #step: withScheduler:, or #finish:. After a crash, the job will 
be sent #restart to acquire a new memento." 

self subclassResponsibility. 
A memento! 



!Job methodsFor: 'accessing'! 
tag 

"Answer a (lightweight) JobSynchronizationTag that is used to identify jobs that 
must be synchronized together. Answer nil if no synchronization is required." 

taglnteger — 0 itTrue: [ A nilj. 
A JobSynchronizationTag new fromlnteger: taglnteger! 
tag: aJobSynchronizationTagOrNil 

"Set my (lightweight) tag. This is used to indicate jobs that must be synchronized together." 

aJobSynchronizationTagOrNil isNil 
iflrue: [taglnteger := 0] 

i {False: [taglnteger := aJobSynchronizationTagOrNil taglnteger]! 
taglnteger: anlnteger 

taglnteger := anlnteger.! 



Smalltalk defineClass: #OneStepJob 
superclass: #{ Job} . 
indexedType: #none 
private: false 

instanceVariableNames: " 
classInstanceVariableNames: " 
imports: " 
category: "! 



!OneStepJob methodsFor: "private: execution'! 
atEnd: aMemento 

"Answer whether the job has finished stepping. If so, the #finish: message will be sent to it. 
This method is called within & transaction. Normally, this memento was the result of the previous 
execution step, but after a <SShj the #restart message is sent to acquire a memento." 

A aMemento! ^^£'^v 

t '■ 



!OneStepJob methodsFor: 'execution'! 
executeWith: aContentionSpaceProcess 

self subclassResponsibility.! 

t 
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!OneStepJob methodsFor: 'private: execution'! 
restart 

"The job is restarting after a crash. This method is called within a transaction. Answer 

a memento that will be passed to #atEnd:, #step:withScheduIer: t and tffinish: at a later time." 

A false! 

start 

"The job is starting (for the first time, at least as far as what was committed). 
This method is called within a transaction. Answer a memento that will be 
passed to flatEnd:, #step:withScheduler:, and #finish: at a later time." 

A false! 

step: memento withScheduler: scheduler 

"Step the job. If an output row is needed, just ask the scheduler for its currentOutputRow. 
This method is called within a transaction. Answer a new memento to be used in 
successive calls to #atEnd:, #step:withSchedulen, or #finish:. After a crash, the job will 
be sent tfrestart to acquire a new memento." 

self executeWith: scheduler. 
A true! 



Smalltalk defmeClass: #BouncingJob 
superclass: #{OneStepJob} 
indexedType: #none 
private: false 
instance VariableNames: ' 

bounces <uint32> 

firstBounceTime <uint32> 

lastBounceTime <uint32> 

sumOfSquares <uint32> ' 
class Instance VariableNames: " 
imports: " 
category: "! 

'.BouncingJob class methodsFor: 'filling & cleaning up*! 
collectingStatistics 

CollectingStatistics isNil ifTrue: [ 
CollectingStatistics := false]. 
CollectingStatistics! 
collectingStatistics: aBoolean 

"When true, this process aggregates the information from all the BouncingJobs that arrive here. 
When false, the process simply bounces a copy of the job back into the scheduler with updated 
statistics." 

"BouncingJob collectingStatistics: true" 
"BouncingJob collectingStatistics: false" 

CollectingStatistics := aBoolean. 
CollectingStatistics ifFalse: [ 

TotalBounces := 0. 

TotalBounceTimes := 0. 

TotalSquaredBounceTinpes :*= 0. 

EarliestBounceTime :~#3<e20. 

LatestBounceTimc :--'fc26. 
i. W: 



19 



describeStatistics 

"Describe the statistics previously collected." 
"BouncingJob describeStatistics" 

| out columns mean | 

DatabaseSession currentSession transaction: [ 

columns := MioSystem currentPersistent maxContentionlndex]. 
out := WriteStream on: String new. 
Total Bounces > 1 ifTrue: [ 

| pop Variance stdDev elapsed | 

mean := (TotalBounceTimes / TotalBounces) asFloat. 

popVariance := (TotalSquaredBounceTimes / TotalBounces) - mean squared. 

stdDev := (popVariance * TotalBounces / (TotalBounces - 1)) sqrt. 

elapsed := LatestBounceTime - EarliestBounceTime max: 1 . 

out 

nextPutAU: 

print: TotalBounces; nextPutAU: \ '; 
print: elapsed; nextPutAU: \ '; 
print: mean; nextPutAU: \ '; 
print: stdDev; nextPutAU: \ '; 

print: (elapsed / TotalBounces) * 1000.0; nextPutAU: \ 
print: TotalBounces / elapsed asFloat; cr; 

nextPutAU: 'Proc, jobs exec, time, lat, lat dev. CPU ms/job, jobs/(CPU s)\ 

]■ 

A out contents! 



! BouncingJob class methodsFor: 'private 1 ! 
initialize 

ObjectMemory removeDependent: self. 
ObjectMemory addDependent: self! 
obsolete 

super obsolete. 

ObjectMemory removeDependent: self! 



! BouncingJob class methodsFor: 'private: generated'! 
ooCodeGen Version 

A l! 

ooTypedlnstanceVariablesString 

A I 

bounces <uint32> 
firstBounceTime <uint32> 
lastBounceTime <uint32> 
sumOfSquares <uint32> '! 

i 



! BouncingJob class methodsFor: 'private'! 
random 

Rnd isNil ifTrue: [Rnd := Random new]. 
A Rnd! 

! 

! BouncingJob class methodsFor: 'filling & cleaning up'! 
resets tatistics 

"Reset my statistics." 

"BouncingJob resetStatistics" 

TotalBounces :- 0. 
TotalBounceTimes := 0. 
TotalSquaredBounceTimes := 0. 
EarliestBounceTime := le20. 
LatestBounceTime :« -le20.! 

i 
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! BouncingJob class methodsFor: 'private*! 

update: anAspectSymbol with: aParameter from: aSender 

aSender = ObjectMemory ifTrue: [ 

anAspectSymbol = #retumFromSnapshot ifTrue: [ 
Rnd := nil]]. 

A super update: anAspectSymbol with: aParameter from: aSender! 



!BouncingJob class methodsFor: 'EM-Internal'! 
_PRAGMA_ 

"(defineStatic: #Rnd private: false constant: false category: 'As yet unclassified' initializer: nil)" 
"(defineStatic: #CollectingStatistics private: false constant: false category: 'As yet unclassified' initializer: nil)" 
"(defineStatic: #TotalBounces private: false constant: false category: 'As yet unclassified' initializer: nil)" 
"(defineStatic: #TotalBounceTimes private: false constant: false category: 'As yet unclassified' initializer: nil)" 
"(defineStatic: #TotalSquaredBounceTimes private: false constant: false category: 'As yet unclassified' initializer: nil)" 
"(defineStatic: #EarliestBounceTime private: false constant: false category: 'As yet unclassified' initializer: nil)" 
"(defineStatic: # LatestBounceTime private: false constant: false category: 'As yet unclassified' initializer: nil)"! 



!BouncingJob methodsFor: 'accessing'! 

bounces: intl firstBounceTime: int2 lastBounceTime: int3 sumOfSquares: int4 

bounces := intl. 
firstBounceTime := int2. 
lastBounceTime := int3. 
sumOfSquares :- int4.! 



! BouncingJob methodsFor: 'execution'! 
executeWith: aContentionSpaceProcess 

"I simply add another BouncingJob into a random contention space." 

\ now | 

now := Timestamp now asSeconds. "Don't run tests past midnight." 
bounces = 0 
ifTrue: [ 

firstBounceTime := now. 

EarliestBounceTime := EarliestBounceTime min: firstBounceTime] 
ifFalse: [ 

sumOfSquares := sumOfSquares + (now - lastBounceTime) squared]. 
lastBounceTime := now. 
bounces = 10 
ifTrue: [ 

"Don't count the length of time this job sat in the scheduler just prior to statistics collection." 
TotalBounces := TotalBounces + bounces, "count *complete* trips through contention space processes." 
TotalBounceTimes := TotalBounceTimes + lastBounceTime - firstBounceTime. 
TotalSquaredBounceTimes := TotalSquaredBounceTimes + sumOfSquares. 
LatestBounceTime := LatestBounceTime max: lastBounceTime] 
ifFalse: [ 

"We're not compiling statistics yet, so shuffle this job around." 
| targetSpace | . 
bounces := bowSS^ 1. 

targetSpace (i||fglass random next * aContentionSpaceProcess numberOfContentionSpaces) truncated + 1 . 
aContentionSpaaSPfcfcess addJob: (self copy 
contentionlhdex: targetSpace)].! 

» 



! BouncingJob methodsFor: 'instance initialization'! 
initialize 

super initialize, 
bounces := 0. 
firstBounceTime := 0. 
lastBounceTime := 0. 
sumOfSquares :=0.! 
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Smalltalk defineClass: IQueueControlJob 
superclass: #{OneStepJob} 
indexcdType: #none 
private: false 
instanceVariableNames: ' 

command <ooVString> ' 
class InstanceVariableNames: w 
imports: " 
category: "! 



IQueueControlJob class methodsFor: 'private: generated'! 
ooCodeGenVersion 

A 1! 

ooTypedlnstanceVariablesString 

A > 

command <ooVString> '! 



IQueueControlJob methodsFor: 'accessing'! 
command: aString 

command := aString.! 



!QueueControlJob methodsFor: 'execution'! 
executeWith: aContentionSpaceProcess 

Transcript cr; cr; show: *************** Executing command: *"; show: command; nextPutAll: 
Compiler evaluate: command.! 



Smalltalk defineClass: #ReplyToChangeNodeJob 
superclass: #{OneStepJob} 
indexedType: #none 
private: false 
instanceVariableNames: ' 

changeNode <ChangeNode> 

newObject <Object> * 
classInstanceVariableNames: " 
imports: " 
category: "! 



!ReplyToChangeNodeJob class methodsFor: 'private: generated'! 
ooCodeGenVersion 

A l! 

ooTypedlnstanceVariablesString 

A I 

changeNode <ChangeNode> 
newObject <Object> '! - 



JReplyToChangeNodeJob methodsFor: 'accessing'! 
changeNode: aChangeNode 

changeNode := aChangeNode. ! 

i 
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IReplyToChangeNodeJob methodsFor: 'execution'! 
execute With: aContentionSpaceProcess 

[changeNode isBusy] assert. 

changeNode isDestinedForDestruction ifTrue: [ 

"This ChangeNode was simply disconnecting its object as its final act. It should now 
be destroyed. It was already removed from its CompareDictionary." 
changeNode newVersion notNil ifTrue: [ 

changeNode newVersion ooDelete. 

changeNode newVersion: nil]. 
changeNode oldVersion notNil ifTrue: [ 

changeNode oldVersion ooDelete. 

changeNode oldVersion: nil]. 
newObject isNil 

ifTrue: [ 

"The object has been deleted. Delete this change node." 
changeNode ooDelete] 
ifFalse: [ 

"The object was just finished creating or updating itself. That must have been 
happening when the change node was marked for deletion. Therefore, send 
another update request to the object (telling it to delete itself)-" 
[changeNode isChangedWhileBusy] assert. 
changeNode isChangedWhileBusy: false. 
changeNode object: nil. 

aContentionSpaceProcess addJob: (UpdateObjectlob new 
contentionlndex: changeNode objectContentionlndex; 
objectOrNil: newObject; 
coclusterObject: newObject; 
record: nil; 

changeNode: changeNode; 
changeNodeContentionlndex: contentionlndex)]. 

A self]. 

changeNode object: newObject. 

changeNode isChangedWhileBusy 
ifTrue: [ 

| dataSource policy j 

dataSource := changeNode dataSource. 

policy :- (MioSystem currentPersistent: aContentionSpaceProcess session) 
clusteringPolicyAt: dataSource mappableRoot small talkClassName. 

changeNode 

createCatchUpJobln: aContentionSpaceProcess 
policy: policy] 

ifFalse: [ 

changeNode isBusy: false].! 



.'ReplyToChangeNodeJob methodsFor: 'accessing'! 
newObject: anObject 

newObject := anObject.! 



Smalltalk defineClass: # Requested*) b 

superclass: #{OneStepJob}j^if 

indexedType: #none 

private: false 

instance VariableNames: ' 

dataSource <DataSource> 
filename <ooVString> 
requestTime <uint64> ' 

classlnstance VariableNames: " 

imports: " 

category: "! 
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!RequestLoadJob class methodsFor: 'private: generated'! 
ooCodeGenVersion 

M! 

ooTyped Instance VariablesString 

A I 

dataSource <DataSource> 
filename <ooVString> 
requestTime <uint64> '! 



!RequestLoadJob methodsFor: 'accessing'! 
dataSource: aDataSource 

dataSource := aDataSource.! 
filename: aString 

filename := aString.! 
requestTime: milliseconds 

requestTime := milliseconds.! 



Smalltalk defineClass: #UpdateObjecUob 

superclass: #{OneStepJob} 

indexedType: #none 

private: false 

instance VariableNames: ' 
objectOrNil <Object> 
coclusterObject <Object> 
changeNode <ChangeNode> 
record <ooShortRef(SourceRecord)> 
changeNodeContention Index <uintl6> ' 

class Instance VariableNames: " 

imports: " 

category: "! 

!UpdateObjecUob class methodsFor: 'private: generated'! 
ooCodeGenVersion 

A 1! 

ooTypedlnstanceVariablesString 

A • 

objectOrNil <Object> 
coclusterObject <Object> 
changeNode <ChangeNode> 
record <ooShortRefl(SourceRecord)> 
changeNodeContentionlndex <uintl6> '! 

i 



!UpdateObjecUob methodsFor: 'accessing'! 
changeNode: aChangeNode >v 

changeNode := aChangeNode: P~ 
changeNodeContentionlndex: anlnteger 

changeNodeContentionlndex := anlnteger.! 
coclusterObject: anObject 

coclusterObject := anObject.! 



!UpdateObjecUob methodsFor: 'execution*! 

executeWith: aComentionSpaceProcess 

M A change node has gotten a new record. Since we locked the the change node by setting the isBusy flag 
at the moment the new record was plugged in (into the oldVersion field), we know that nobody else has 
messed with that field in the interim (if someone saw the isBusy flag during a subsequent load, they would 
store the new record in the newVersion field and set the isChangedWhileBusy flag)." 

| newObject | 

[record = changeNode oldVersion] assert." 
record isNil ifTrue: [ 

"We need to do a deletion." 

| remoteEntries | 

[objectOrNil notNil] assert: 'A change node should not be marked for deletion until it"s stable*. 
[changeNode object isNil] assert: 'The object should have been disconnected from the change node already'." 
remoteEntries := objectOrNil remotelndexEntries. 
objectOrNil changeNode: nil. "disconnect it immediately." 
objectOrNil isStable 
ifTrue: [ 

remoteEntries is Empty 
ifTrue: [ 

"Delete the object now and reply to the change node." 
objectOrNil delete] 
ifFalse: [ 

"Start deleting the object's remote index entries." 
I tag | 

tag := aContentionSpace Process nextUniquelnteger. 
remoteEntries do: [:entry | 

entry ooClass cachelndexIfNilForSession: aContentionSpaceProcess session. 
aContentionSpaceProcess addJob: (IndexEntryDeleteJob new 
contentionlndex: entry contentionlndex; 
indexedObject: objectOrNil; 
indexEntry: entry; 
replyTag: tag; 

replyQuorumDenominator: remoteEntries size; 

objectContentionlndex: contentionlndex)]. 
objectOrNil be Deleting. 
objectOrNil remotelndexEntries: Array new]] 

ifFalse: [ 

[objectOrNil is Deleting not] assert: 'How could a second delete be requested?'. 
objectOrNil requestDeletion]. 
aContentionSpaceProcess addJob: (ReplyToChangeNodeJob new 
contentionlndex: changeNodeContentionlndex; 
changeNode: changeNode; 
newObject: nil). 
A self|. 

(objectOrNil isNil or: [objectOrNil isStable]) 
ifTrue: [ 

| oldTransients plan | 
objectOrNil isNil 
ifTrue: [ 

oldTransients := Array new] 
ifFalse: [ 

oldTransients := objectOrNil transientlndexEntries. 

[oldTransients size - objectOrNil remotelndexEntries size] assert], 
plan := record file filcFormat objectConstructionPlanForPolicy: ObjectConstructionPolicy new. 
newObject := plan executeWithRecord: record oldObject: objectOrNil. 
newObject changeNode: changeNode. 
newObject clusterWrth: coclusterObject. 

[objectOrNil isNil or: [newObject = objectOrNil]] assert: 'Root object identities must be preserved (currently).'. 

IndexEntryTracker new 

contentionSpaceProcess: aContentionSpaceProcess 
object: newObject 

objectContentionlndex: contentionlndex 
oldTransientsIfKnown: oldTransients] 

ifFalse: [ 

newObject := objectOrNil. 

[newObject isDeleting not] assert: 'Why on earth is an object doomed to deletion being updated?'. 
[newObject isReindexing] assert. 
newObject requestReindexing]. 

"Send back a job that will 

(A) ensure the changeNode points to the object (not always necessary), and 
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(B) check for pending updates/deletes on the changeNode, queueing jobs as necessary." 
aContentionSpaceProcess add Job: (ReplyToChangeNodeJob new 
contentionlndex: changeNodeContentionlndex; 
changeNode: changeNode; 
newObject: newObject).! 



! UpdateObjecUob methodsFor: 'accessing'! 
objectOrNil: anObject 

objectOrNil := anObject.! 



! UpdateObjecUob methodsFor: 'deleting'! 
ooDelete 

record ooDelete. 
super ooDelete.! 



! UpdateObjecUob methodsFor: 'copying'! 
postCopy 

super postCopy. 
record := record copy.! 



! UpdateObjecUob methodsFor: 'accessing'! 
record: aSourceRecordOrNil 

record := aSourceRecordOrNil.! 



Smalltalk defineClass: #RecordLoadingJob 

superclass: #{Job} 

indexedType: #none 

private: false 

instance VariableNames: ' 
filename <ooVString> 
dataSource <DataSource> ' 

classInstanceVariableNames: " 

imports: " 

category: "! 



! Record LoadingJob class methodsFor: 'private: generated'! 
ooCodeGenVersion 

A 1! 

ooTypedlnstanceVariablesString 

A • 

filename <ooVString> 
dataSource <DataSource> '1 

i 



!RecordLoadingJob methodsFor 'execution'! 

atEnd: sourceFileMemento 

"Answer whether the job has finished stepping. If so, the #finish: message will be sent to it. 
This method is called within a transaction. Normally, this memento was the result of the previous 
execution step, but after a crash, the #restart message is sent to acquire a memento." 

A sourceFileMemento atEnd! 

i 



26 



!RecordLoadingJob methodsFor: 'accessing'! 
dataSource: aDataSource 

dataSource :« aDataSource.! 
filename: aString 

filename := aString.! 



! Record Load ingJob methodsFor: 'execution'! 

finish: sourceFileMemento withScheduter: aJobScheduler 

"The job is finished, so do any final actions necessary. 

This method is called within a transaction." 

[self atEnd: sourceFileMemento] assert. 

self snapshot finish: sourceFileMemento withScheduler: aJobScheduler.! 
restart 

"The job is restarting after a crash. This method is called within a transaction. Answer 

a memento that will be passed to #atEnd:, #step: withScheduler:, and #finish: at a later time." 

A self snapshot sourceFile ! 



! Record LoadingJob methodsFor: 'accessing'! 
snapshot 

A dataSource snapshots last! 



JRecordLoadingJob methodsFor: 'execution'! 
start 

"The job is starting (for the first time, at least as far as what was committed). 
This method is called within a transaction. Answer a memento that will be 
passed to #atEnd:, #step:withScheduler:, and #fmish: at a later time." 

| session sys tempMap formatMap formatCopy newSnapshot | 
session := dataSource ooContainer session, 
sys := MioSystem currentPersistent: session. 

tempMap := IdentityDictionary new. 

sys schema deepCopyCreatingHomomorphisrn: tempMap. 

formatMap := IdentityDictionary new. 

tempMap keysDo: [:stub | 

formatMap at: stub put: stub]. 
formatMap at: dataSource put: dataSource. 

formatCopy := dataSource currentFormat deepCopyCreatingHomomorphisrn: formatMap. 

newSnapshot DataSnapshot 

dataSource: dataSource 

fileName: filename 

format: formatCopy. 
dataSource cluster: newSnapshot 
dataSource addSnapshot: ne^&napshot. 

newSnapshot createRecord|^mtainerInColurnn: contentionlndex. 

A self snapshot sourceFile! »s^r 
step: sourceFileMemento withScheduler: scheduler 

"Step the job. If an output row is needed, just ask the scheduler for its currentOutputRow. 
This method is called within a transaction. Answer a new memento to be used in 
successive calls to #atEnd:, #step:withScheduler:, or #finish:. After a crash, the job will 
be sent #restart to acquire a new memento." 

self snapshot loadNextRecordFrom: sourceFileMemento jobScheduler: scheduler. 
SourceFileMemento! 

i 
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Smalltalk defineClass: # JobBuffer 
superclass: #{ Core. Object} 
indexedType: #none 
private: false 
instanceVariableNames: ' 

firsUobld <uint32> 

nexUobld <uint32> 

firsUoblndex <uint32> 

numberedJobs <oo VArTay(ooShortRef(Job))> 

toWrite <ooTransienP > ' 
classInstanceVariableNames: " 
imports: " 
category: "! 



UobBuffer class methodsFor: 'instance creation*! 
new 

A super new initialize! 

i 



! JobBuffer class methodsFor: 'private: generated'! 
ooCodeGenVersion 



A 1! 

ooTyped Instance VariablesString 



firsUobld <uint32> 
nexUobld <uint32> 
firsUoblndex <uint32> 

numberedJobs <ooVArray(ooShortRef(Job))> 
to Write <ooTransient> '! 



! JobBuffer methodsFor: 'accessing'! 
add Job: aJob 

aJob oolsPersistent ifTrue: [ 

self error: 'Jobs to be transmitted must not be persistent']. 
toWrite isNil ifTrue: [toWrite := OrderedCollection new], 
to Write addLast: aJob.! 



! JobBuffer methodsFor: 'ui support'! 
currenUobCount 

"Used for saturation testing." 

NexUobld "Assumes 32-bit wrapping won't happen during test." 



5'*" 
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UobBuffer methodsFor: 'accessing'! 

deleteJobsUpTo: jobld 

"Delete all jobs up to and including the one with the given jobld. This message might 
arrive more than once, so be careful to ignore it if it specifies a job that has already 
been deleted. It should never be more than two billion jobs out of date, otherwise the 
update stream processor may fail. Answer the actual number of jobs deleted." 

| firstToKeep howManyToK.il 1 1 

flrstToKeep := jobld + 1 "bitAnd: 16rFFFFFFFF". 

howManyToKill := firstToKeep - firsUobld bitAnd: 16rFFFFFFFF. 

howManyToKill > 16r8000OO00 ifTrue: [ 

"A request to delete more than two billion jobs is (probably) really a request to 
delete a negative number of jobs, i.e., these jobs have already been deleted." 
*0]. 

numberedJobs accessln: [ 
| size | 

size := numberedJobs size. 
howManyToKill timesRepeat: [ 
I job | 

job := numberedJobs at: firsUoblndex. 
numberedJobs at: firsUoblndex put: nil. 
job ooDelete. 

firsUoblndex := firsUoblndex \\ size + 1]. 
firsUobld := firsUobld + howManyToKill bitAnd: 16rFFFFFFFF]. 
self ooUpdate. "Potential Objectivity bug" 
A howManyToKill! 

! 



UobBuffer methodsFor: 'initialize-release'! 
initialize 

firsUobld :=1. 
nexUobld := 1 . 
firsUoblndex := 1 . 

numberedJobs := OoV Array new: 100.! 



UobBuffer methodsFor: 'accessing'! 
prepareToCommit 

"Write persistent copies of the new jobs into the database. Answer the (original) transient jobs for 
which copies were written, these will be transmitted (after the commit) to the host responsible for 
executing them." 

| size result | 

(to Write isNil or: [to Write isEmpty]) ifTrue: [*#()]. 

size to Write size. 

result := self prepareToCommitHelpeT. 

[size = result size] assert. 

A result! 

i 
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UobBuffer methodsFor: 'private-helper'! 

prepareToCommitHelper 

"Write persistent copies of the new jobs into the database. Answer the (original) transient jobs for 
which copies were written. These will be transmitted (after the commit) to the host responsible for 
executing them." 

| size capacity position result | 

[toWrite notNil and: [to Write notEmpty]] assert. 

numberedJobs accessln: [ 

size := nexUobld - firsUobld bitAnd: 16rFFFFFFFF. 

capacity := numberedJobs size. 

size + toWrite size >= capacity ifTrue: [ 

"Not enough room to add all the jobs. Enlarge the buffer to the new required capacity * 1 

| newCapacity growth lastlndex | 

newCapacity := (size + toWrite size) * 3 // 2 + 2. 

growth := newCapacity • capacity. 

numberedJobs changeSizeTo: newCapacity. 

self ooUpdate. "Objectivity bug" 

lastlndex := firsUoblndex + size - 1. 

lastlndex > capacity ifTrue: [ 

"The data wrapped around past the end of the old buffer. Move that part of it to 
the end of the new buffer. " 
numberedJobs 

replaceFrom: firsUoblndex + growth 
to: newCapacity 
with: numberedJobs 
startingAt: firsUoblndex. 
numberedJobs 

atAll: (firsUoblndex to: firsUoblndex + growth - 1) 
put: nil. 

firsUoblndex := firsUoblndex + growth]. 

capacity := newCapacity]. 
size + toWrite size >= capacity ifTrue: [self error: 'Bug in circular buffer growth algorithm'], 
position := firsUoblndex + nexUobld - firsUobld. 
position := (position -\)\\ capacity + 1 . 
toWrite do: [:job | 

jobjobld: nexUobld. 

nexUobld := nexUobld + 1 bitAnd: 1 6rFFFFFFFF. 
[(numberedJobs at: position) isNil] assert. 
numberedJobs at: position put: job copy, 
position := position \\ capacity + 1]]. 

result := toWrite. 
toWrite := nil. 
Result! 



UobBuffer methodsFor: 'ui support'! 
resetAHJobs 

"This is extremely dangerous, and is only to be used for testing. Delete all jobs and 
reset my job numbering counters." 

numberedJobs do: [:j | 

j — nil ifFalse: [j ooDelete]]. 
numberedJobs atAHPut: nil; . 
firsUobld := 1. 
nexUobld := 1. 
firsUoblndex := 1 . 

numberedJobs := OoV Array new: 100. 
toWrite := nil.! 
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UobBuffer methodsFor: 'recovery*! 
retransmilAllViaChannel: jobChannel 

"This is part of the recovery algorithm. Retransmit all jobs still in this buffer. A contention space 

will simply ignore jobs that have already been executed. This must be called within an MROW 

transaction." 

| count usp lastExecuted | 
[jobChannel wasRecovered] assert. 

"First, check with the contention space at the other end (via Objectivity) to see how far it got before the crash." 

usp := UpdateStreamProcessor named: 'Main' inSession: self ooContainer session. 

lastExecuted - (usp panic ipantAt: jobChannel remoteld) lasUobsExecuted at: jobChannel myld. 

"Don't retransmit any of the completed jobs." 
self deleteJobsUpTo: lastExecuted. 

"Transmit everything after the point at which it stopped executing." 
count := nextlobld - firsUobld bitAnd: 16rFFFFFFFF. 

USPControllerService current at: 1 log: 'Retransmitting ', count printString, 'jobs from 'JobChannel myld printString, ' to 'JobChannel remoteld printString. 
jobChannel wasRecovered: false. 
jobChannel start, 
numbered Jobs accessln: [ 

| index clump | 

index := firsUoblndex. 

clump := OrderedCollection new: 500. 

count timesRepeat: [ 
| job | 

job := numbered Jobs at: index, 
[job notNil] assert, 
clump addLast: job copy, 
clump size = 1000 ifTrue: [ 

jobChannel nextPutAll: clump. 

clump remove Last: clump size], 
index := index + 1 . 

index > numberedJobs size ifTrue: [index := 1 ]]. 
jobChannel nextPutAll: clump. 

].! 



Smalltalk defineClass: #SaturationTestJobBufler 
superclass: #{JobBuffer} 
indexedType: #none 
private: false 
instance VariableNames: " 
classInstanceVariableNames: " 
imports: " 
category: "! 



! Saturation Testl obBuffer methodsFor: 'accessing'! 
addJob: aJob 

"Note - we don't actually store the job for the saturation test." 

aJob oolsPersistent ifTrue: [ 

self error: 'Jobs to be transmitted must not be persistent'], 
to Write isNil ifTrue: [toWriteSf OrderedColiection new], 
to Write addLast: aJob.! ^ 
deleteJobsUpToJobld 

"*** Saturation test requiresihat I not actually persist my jobs." 

| firstToKeep howManyToKill | 

firstToKeep := jobld + 1 "bitAnd: 1 6rFFFFFFFF". 

howManyToKill := firstToKeep - firsUobld bitAnd: 1 6rFFFFFFFF. 

howManyToKill > 16r80000000 ifTrue: [ 

"A request to delete more than two billion jobs is (probably) really a request to 
delete a negative number of jobs, i.e., these jobs have already been deleted." 
A 0]. 

firsUoblndex := 1 . 

firsUobld := firsUobld + howManyToKill bitAnd: 1 6rFFFFFFFF. 
A howManyToKill! 

i 
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iSaturationTesUobBufler methodsFor: 'recovery'! 
initialize 



super initialize. 

numberedJobs := OoVArray new. "This instvar should be unused."! 



ISaturationTestJobBuffer methodsFor: *private -helper'! 

prepareToCommitHelper 

"Write persistent copies of the new jobs into the database. Answer the (original) transient jobs for 
which copies were written. These will be transmitted (after the commit) to the host responsible for 
executing them." 

"Don't write the jobs to the database. This is a saturation test." 
| result | 

[to Write notNil and: [toWrite notEmpty]] assert. 

to Write do: [:job | 

jobjobld: nexUobld. 

nexUobld := nexUobld + 1 bitAnd: 16rFFFFFFFF]. 

result := to Write. 
toWrite := nil. 
A result! 



!SaturationTesUobBuffer methodsFor: 'recovery'! 

retransmitAUViaChannel: jobChannel 

"This is part of the recovery algorithm. Retransmit all jobs still in this buffer. A contention space 
will simply ignore jobs that have already been executed. This must be called within a transaction." 
"The saturation test supresses persistent storage of jobs with the producer. Do nothing." 

| usp lastExecuted | 

[jobChannel wasRecovered] assert. 

"First, check with the contention space at the other end (via Objectivity) to see how far it got before the crash." 

usp :« UpdateStreamProcessor named: 'Main* inSession: self ooContainer session. 

lastExecuted := (usp participantAt: jobChannel remoteld) lasUobs Executed at: jobChannel myld. 

"Reset my numbering to correspond with the last actually executed job." 
self deleteJobsUpTo: lastExecuted. 

nexUobld := firsUobld. "don't worry about reusing the id's - the jobs were lost forever." 

USPControllerService current at: 1 log: "(Not retransmitting anything, due to saturation test)'. 
jobChannel wasRecovered: false. 
jobChannel start.! 



Smalltalk defineClass: #JobChannel 
superclass: #{Core.Object} 
indexedType: #none 
private: false 

instanceVariableNames: 'outQueue inQueue socket writerProcess readerProcess myld remoteld isCpnnecting activator passivator onConnect onDisconnect 
wasRecovered ' ^. . 

classInstanceVariableNamMpV 
imports: " 
category: "! 



! JobChannel class methodsFor: 'instance creation'! 



A super new initialize! 
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UobChannel class methodsFor: TEST'! 
testl 

"A simple test with two JobChannels connected together via a pair of sockets." 
"JobChannel testl" 

| pair si s2 chl ch2 result | 
pair := SocketAccessor openPair. 
si := pair first. 
s2 := pair last. 

chl := self new socket: si; myld: 1. 
ch2 := self new socket: s2; myld: 2. 
chl start. 
ch2 start. 

chl nextPut: #(1 2 3); nextPut: #(#Test). 
ch2 nextPut: #(*Hello' #[10]). 
(Delay forMilliseconds: 1000) wait. 

[chl is Empty not] assert. 
[ch2 isEmpty not] assert, 
result := ch2 next, 
[result = #(1 2 3)] assert. 
[ch2 isEmpty not] assert, 
result := ch2 next, 
[result = #(#Test)] assert. 
[ch2 isEmpty] assert. 

result := chl next. 

[result = #('Hello' #[10])] assert. 

[chl isEmpty] assert. 

chl stop. 

ch2stop.! 
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UobChannel methodsFor: 'private looping'! 
doReading 

"Loop forever, reading from the socket. Stop when my socket closes (or is replaced by nil)." 

| sock read size Holder sizeBytes size | 

(sock := socket) isNil ifTrue: [ A self|. 

read := sock readStream binary. 

size Holder :« UninterpretedBytes new: 4. 

sizeBytes := ByteArray new: 4. 

[ 

remoteld := read nextLong. 

[remoteld islnteger] assert. 

onConnect notNil ifTrue: [onConnect value: self). 

[ 

| bytes | 

read next: 4 into: sizeBytes startingAt: 1 . 

sizeHolder replace By tesFrom: 1 to: 4 with: sizeBytes startingAt: 1 . 
socket isNil ifTrue: [ A self). 
size := sizeHolder unsigned LongAt: 1 . 
bytes := read next: size, 
socket isNil ifTrue: [^elfj. 
inQueue nextPut: bytes. 
] repeat. 

] 

on: 

Stream endOfStreamSignal, 
Stream incompleteNextCountSignal, 
OSErrorHolder peerFaultSignal, 
OSErrorHolder unpreparedOperationSignal, 
OSErrorHolder unsupportedOperationSignal 
do: [:ex | 
IPI 

(p := writerProcess) notNil ifTrue: [p terminate]. 

on Disconnect notNil ifTrue: [on Disconnect value: self]. 

A self|.! 

do Writing 

"Loop forever, writing to the socket. Stop when my socket closes (or is replaced by nil)." 

| sock write sizeHolder | 
(sock := socket) isNil ifTrue: [ A self|. 
write := sock writeStream binary. 
sizeHolder := UninterpretedBytes new: 4. 

[ 

write nextLongPut: my Id; commit. 
[ 

| object bytes | 

object := outQueue next. 

bytes := passivator convert: object. 

socket isNil ifTrue: [ A self]. 

sizeHolder unsignedLongAt: 1 put: bytes size. 

write nextPutAll: sizeHolder asByteArray. 

write nextPutAll: bytes. 

socket isNil ifTrue: [ A self|. 

outQueue isEmpty ifTrue: [ 

"Transcript cr; show: 'Short packet: ', write position printString." 

write comnrit]; 
] repeat. .i§|£ ' 

on: 

Stream endOfStreamSignal, 
Stream incompleteNextCountSignal, 
OSErrorHolder peerFaultSignal, 
OSErrorHolder unpreparedOperationSignal, 
OSErrorHolder unsupportedOperationSignal 
do: [:ex | 

"The disconnect action is taken when the "reader* process notices the socket is closed." 
A se1f].! 
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! JobChannel methodsFor: 'accessing'! 
hasFirmConnection 

isConnecting ifTrue: [ A false]. 
was Recovered ifTrue: [ A false]. 

(socket isNil or: [readerProcess isNil or: (writerProcess isNil]]) ifTrue: [ A false]. 
[ 

socket primGetPeer 

] 

on: 

OSErrorHolder peerFaultSignal, 
OSErrorHolder unpreparedOperationSignal 
do: [:ex | 

self stop. 
A false]. 

A true! 



UobChannel methodsFor: 'initialize-release'! 
initialize 

outQueue := SharedQueue new. 
inQueue := SharedQueue new. 
isConnecting := false. 
wasRecovered := false.! 



! JobChannel methodsFor: 'accessing'! 
isEmpty 

A inQueue isEmpty! 

myld 

A myld! 
myld: anlnteger 

myld := anlnteger.! 

next 

"This is only valid if there are no references to persistent objects coming through this channel. If there 
are persistent object references, you should use #nextUsingSession:." 

A self nextUsingSession: nil! 
nextPut: anObject 

"Push the object onto my outgoing objects queue." 

passivator notNil ifTrue: [ 

"There's no way to write at this time, so assume the recovery procedure will transmit this job eventually." 
outQueue nextPut: anObject].! 
nextPutAll: aCollectionOfObjects 

"Push the objects onto my outgoing objects queue." 

passivator notNil ifTrue: [ 

"There's no way to write at this time, so assume the recovery procedure will transmit this job eventually." 
outQueue nextPutAll: aCollectionOfObjects].! 
nextUsingSession: aSession 

"Decode the next object fromthe inQueue. We postpone decoding these messages until the object 
is actually requested (i.e., now); so that we can correctly connect to Objectivity/DB objects. Note 
that the activator requires an OoSession in order to decode such objects." 

I bytes | 

bytes := inQueue next. 

activator isNil ifTrue: [self error: 'Activator was destroyed with data in channel']. 
A activator 

session: aSession; 

convert: bytes! 
onConnect: aBlock 

"The block takes myself as an argument. It is invoked once the remoteld has been received." 
onConnect := aBlock.! 



35 



onDisconnect: aBlock 

"The block takes myself as an argument. It is invoked when the connection is broken." 

onDisconnect := aBlock.! 



UobChannel methodsFor: "printing'! 
printOn: aStream 

a Stream 

nextPutAll: , JobChannel(sock='; 

print: (socket notNil ifTrue: [socket getName]); 

nextPutAll: \ writer '; 

nextPutAll: (writerProcess isNil ifTrue: ['not *] ifFalse: ["]); 
nextPutAll: 'active, reader '; 

nextPutAll: (readerProcess isNil ifTrue: ['not '] ifFalse: ["]); 

nextPutAll: 'active, inQueue-; 

print: inQueue size; 

nextPutAll: \ outQueue='; 

print: outQueue size; 

nextPutAll: ')'.! 



!JobChannel methodsFor: 'accessing'! 
privateReestablishlfNecessaryFor: anUpdateStreamProcessor 

"If the socket has been closed, attempt to reestablish a connection with the target job execution process. 

Assume this is called within an MROW transaction." 

| otherSpace otherIP otherPort | 

wasRecovered := false, "just in case." 
isConnecting := true, 
self stop. 

otherSpace := anUpdateStreamProcessor participantAt: remoteld. 
otherIP := otherSpace hostName. 
otherPort := otherSpace port. 
(otherIP notEmpty and: [otherPort ~= 0]) ifTrue: [ 
[ "fork" 

[ "ifCurtailed:" 
[ "on:do: M 

USPControllerService current at: 2 log: 'Reestablishing link from ', myld printString, 

' to ', remoteld printString, '...'. 
socket := SocketAccessor 

newTCPclientToHost: otherIP 

port: otherPort. 
isConnecting := false. 
wasRecovered := true. 

USPControllerService current at: 2 log: '...done reconnecting *, myld printString, 
* to ', remoteld printString, '.'. 

] 

on: OSErrorHolder peerFaultSignal 
do: [:ex | 

USPControllerService current at: 2 log: '...aborting reconnection attempt from \ myld printString, 

' to ', remoteld printString, '.'. 
self stop. 

^wGonnecting := false. 
6c return: nil]. 
] ifCurtailed: [ Sfe^, 
isConnectfflS^: false, 
self stop. 

]• 

] forkAt: Processor activeProcess priority - 1 . 

].! ■ 
reestablishifNecessaryFor: anUpdateStreamProcessor 

"If the socket has been closed, attempt to reestablish a connection with the target job execution process. 
Assume this is called within an MROW transaction." 

isConnecting ifTrue: [ A self). 
wasRecovered ifTrue: [ A self]. 

(socket isNil or: [readerProcess isNil or: [writerProcess isNil]]) ifFalse: [ A self]. 
A selfprivateReestablishIfNecessaryFor: anUpdateStreamProcessor! 
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remote Id 



A remoteId! 
remoteld: aninteger 

remoteld := an Integer.! 
shouldCheck 

"Answer whether this channel should be processed now. Does not need a transaction." 

isConnecting ifTrue: [ A false]. 
wasRecovered ifTrue: [ A tme]. 

(socket isNil or: [readerProcess isNil or: [writerProcess isNil]]) ifTrue: [ A true]. 
inQueue isEmpty ifFalse: [ A true]. 

A false! 
socket: aSocketAccessor 

socket := aSocketAccessor.! 

start 

"Start up the processes for dealing with jobs and replies. Note that if there is no 
valid socket, neither process will start up. It is the sender's responsibility to attempt 
to reestablish a connection to a failed socket (because of the need to access the 
database to find IP and port numbers)." 

socket isNil ifTrue: [ A selfj. "Do nothing in this case." 

[writerProcess isNil] assert. 

[readerProcess isNil] assert. 

passivatdr := MiosoftPassivator new. 

activator := MiosoftActivator new. 

writerProcess := Process 

forBlock: [[self doWriting] ensure: [writerProcess := nil]] 

priority: Processor userSchedulingPriority - 2. 
readerProcess := Process 

forBlock: [[self doReading] ensure: [readerProcess := nil]] 

priority: Processor userSchedulingPriority -2. 
writerProcess resume. 
readerProcess resume.! 

stop 

"Stop the processes that deal with jobs and replies. Wait until the processes have 
actually stopped." 

| sock p | 
sock := socket, 
socket := nil. 

(p := writerProcess) notNil ifTrue: [p terminate. writerProcess := nil], 
(p := readerProcess) notNil ifTrue: [p terminate. readerProcess :- nil], 
sock notNil ifTrue: [ 

"sock shutdown: 2." "Close read&write directions." 

sock close]. 

[outQueue isEmpty] whileFalse: [outQueue next]. 
outQueue := SharedQueue new.! 
wasRecovered 

"Answer whether this channel has been connected. This lets us know when we need to 
retransmit all jobs through a new socket." 

A wasRecovered! 
wasRecovered: aBoolean 

wasRecovered := aBoolean.! 

t 



Smalltalk defineClass: #SaturatJonTestIobChannel 

superclass: #{JobChannel} 
indexedType: #none 
private: false 

instance Van ableNames: 'jobGenerator ' 
classInstanceVariableNames: " 
imports: " 
category: "! 
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ISaturationTesUobChannel methodsFor: 'accessing'! 
jobGenerator 



A jobGenerator! 
jobGenerator: aBlock 

"This block says how to generate a thousand jobs (when the number of outstanding 
jobs drops below the low water mark)." 

jobGenerator := aBlock.! 



Smalltalk defineClass: #JobSynchronizationTag 
superclass: #{Core.Object} 
indexedType: #none 
private: false 

instanceVariableNames: 'taglnteger hash ' 
classInstanceVariableNames: " 
imports: " 
category: "! 

JobSynchronizationTag methodsFor: 'comparing'! 
- another 

another class = self class ifFalse: [ A false]. 
A self taglnteger = another taglnteger! 



! JobSynchronizationTag methodsFor: 'accessing'! 
fromlnteger: int 

taglnteger := int. 
hash 0. 
1 to: 8 do: [:i | 

hash := (hash + (taglnteger digitAt: i)) times RandomMultiplier].! 



!JobSynchronizationTag methodsFor: 'comparing'! 
hash 

A hash! 



! JobSynchronizationTag methodsFor: 'printing'! 
printOn: aStream 

aStream nextPutAll: *{tag='; print: taglnteger; nextPutAll: '}'.! 



!JobSynchronizationTag methodsFor: 'accessing'! 
taglnteger 

A taglnteger! 



Smalltalk defineCiass: SuSPCodtrollerService 

superclass: # { UI .Model } 
indexedType: #none 
private: false 

instanceVariableNames: 'socket outputSocket outputLock responder runningHosts hostsThatReplied processes session logProtect logEnable ' 
classInstanceVariableNames: " 
imports: " 
category: "! 
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lUSPControllerService class methodsFor: 'class initialization'! 
aboutToQuit 

self current shutdown.! 



lUSPControllerService class methodsFor: 'instance creation'! 
current 

Current isNil ifTrue: [self initialize]. 
A Current! 



lUSPControllerService class methodsFor: 'class initialization'! 
initialize 

"USPControllerService initial ize" 

ObjectMemory remove Dependent: self. 
ObjectMemory addDependent: self. 
Current notNil ifTrue: [ 

[Current shutdown] on: Object errorSignal do: [:ex | ex return]. 

(Delay forMilliseconds: 500) wait]. 
Current := super new initialize startUp. 
LogAccess := Semaphore forMutual Exclusion.! 



lUSPControllerService class methodsFor: 'class accessing'! 
magicPort 

"Answer the port to use for controlling the USP (via datagrams)." 
A 13793! 

i 



lUSPControllerService class methodsFor: 'instance creation'! 
new 

self shouldNotlmplement. "Use #current."l 

i 



lUSPControllerService class methodsFor: 'class initialization'! 
obsolete 

"This class is being removed from the system. Destroy my instance and unregister me." 

self — USPControllerService ifTrue: [ 

Current notNil ifTrue: [Current shutdown]. 

ObjectMemory remove Dependent: self], 
super obsolete! 
retumFromSnapshot 

MiosoftWindowsSupport runDosAndWait: 'cmd /c oocleanup -local c:\miosoft\bin\currentdb*. 
self current startup. ! og* 
update: anAspectSymbol with: aPjaftrneter from: aSender 

aSender = ObjectMemory ifEflse: [^self]. 
anAspectSymbol = #aboutToQuit ifTrue: [ 

self aboutToQuit]. 
anAspectSymbol — tfreturnFromSnapshot ifTrue: [ 

self retumFromSnapshot].! 



lUSPControllerService class methodsFor: 'EM-Intemal'! 
PRAGMA^ 

"(defineStatic: #Current private: false constant: false category: 'As yet unclassified' initializer: nil)" 
"(defineStatic: #LogAccess private: false constant: false category: 'As yet unclassified' initializer, nil)" 
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!USPControllerService methodsFor: 'private - responder*! 
addHost: aString 

((runningHosts includes: aString) 

and: [hostsThatReplied includes: aString]) 
ifFalse: [ 

hostsThatReplied add: aString. 

runningHosts add: aString. 

self changed: #runningHosts].! 



lUSPControllerService methodsFor: 'accessing'! 
add Process: aProcess 

aProcess addDependent: self. 

processes at: aProcess my Id put: aProcess.! 



!USPControllerService methodsFor: 'private - responder'! 
at: indent log: aString 

"Log something to the Transcript (when enabled)." 

logEnable ifTrue: [ 

Transcript dependents first topComponent notNil ifTrue: [ 
logProtect critical: [ 

Transcript crtab: indent; show: aString]]].! 

r 



lUSPControllerService methodsFor: 'private - i/o'! 
broadcast: aString 

"Send this message to every awake host on the local network. Not all 

messages will be received, but that's ok." 

| netAddr | 

[socket notNil] assert. 

self at: 0 log: 'Broadcast: '", aString, "". 

"netAddr := IPSocketAddress 

hostAddress: (IPSocketAddress broadcastAddressForNet: socket getName networkAddress) 

port: self class magicPort." 
netAddr :- IPSocketAddress 

hostAddress: #[255 255 255 255] "non-portable Windows crap" 

port: self class magicPort. 

outputLock critical: [ 
outputSocket 

setOptionsLevel: SocketAccessor solSocket 

name: 32 " = SocketAccessor soBroadcast" 

value: 1. "enable broadcasting." 
outputSocket write Wait. 
outputSocket sendTo: netAddr buffer: aString].! 
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!USPControllerService methodsFor: 'private - responder'! 
handleMessage: msgString from: originatorHostName 
"Handle one message." 

self at: 0 log: 'Received: "\ msgString, ,M from \ originatorHostName. 
('Running on *' match: msgString) ifTrue: [ 
| str host ids | 

str := msgString readStream. 
str skip: 'Running on ' size, 
host := str nextLine. 
self addHost: host, 
ids := Set new. 
[str atEnd] whileFalse: [ 
| line id proc | 

line := str nextLine readStream. 
id := Integer readFrom: line, 
ids add: id. 

line next = Character space ifFalse: [self error: 'Syntax error in status update*], 
proc := self processAt: id. 
proc isNil ifTrue: [ 

proc := RemoteProcess new 

initializeForlndex: id 

host: host 

status: 'should not see this*, 
self addProcess: proc]. 
proc isLocal ifFalse: [ 

proc status: line upToEnd]]. 
processes values do: [:p | 

(p host = host and: [(ids includes: p myld) not]) ifTrue: [ 
self removeProcessId: p myld]]. 
self changed: #status. 
A selfJ. 

('Reboot image' match: msgString) ifTrue: [ 
[ 

self shutdown. 

Win32SystemSupport Create Process: nil arguments: 'cmd /c start c:\miosoft\miocon\ 

[(Delay forSeconds: 10) wait. ObjectMemory quitPrimitive] fork. 

[ObjectMemory quit] fork. 
] fork. 
A self. 

1 

('Shutting down ** match: msgString) ifTrue: [ 

A self removeHost: (msgString readStream skip: 'Shutting down ' size; nextLine)]. 
('Resend greeting' match: msgString) ifTrue: [ 

A self send: self statusMessage toHost: originatorHostName]. 
('Install process *' match: msgString) ifTrue: [ 

A [self install LocalProcess Id: (msgString readStream skip: 'Install process ' size; nextLine) asNumber] fork]. 
('Start process *' match: msgString) ifTrue: [ 

A self startProcessId: (msgString readStream skip: 'Start process * size; nextLine) asNumber]. 
('Stop process *' match: msgString) ifTrue: [ 

A self stopProcessId: (msgString readStream skip: 'Stop process ' size; nextLine) asNumber]. 
('Log *' match: msgString) ifTrue: [ 

A self log: (msgString readStream skip: 'Log ' size; nextLine) from: originatorHostName]. 
('Sync to *' match: msgString) ifTrue: [ 

A self syncTime: (msgString readStream skip: 'Sync to ' size; nextLine)]. 
('Execute *' match: msgStra^); ifTrue: [ 

A [Compiler evaluate: tfegString readStream skip: 'Execute ' size; nextLine)] fork]. 
('Snoop' match: msgString) ifTrue: [ 

'screenshof asFilename%riteStream binary 

nextPutAll: (Passivator convert: (Screen default completeContentsOfArea: Screen default bounds)); 
close. 

A self send: 'Snoop done' toHost: originatorHostName]. 
('Snoop done' match: msgString) ifTrue: [ 

A self changed: #snoopDone with: originatorHostName]. 

self error: 'Unrecognized message'.! 



!USPControllerService methodsFor: 'accessing'! 
hostsThatReplied 

A hostsThatReplied! 
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lUSPControllerService methodsFor: 'initialize-release'! 
initialize 

hostsThatReplied := Set new. . 
runningHosts := Set new. 

processes := Dictionary new. " { id -> (ParticipantProcess | RemoteProcess ) } " 

outputLock := Semaphore forMutualExclusion. 
logProtect := Semaphore forMutualExclusion. 
logEnable := true.! 



lUSPControllerService methodsFor: 'private - responder'! 
installLocalProcessId: index 

"Install a consumer or producer process on this host." 

I proc | 

proc :« self processAt: index, 
proc notNil ifTrue: [ 

A self log: 'Ignored - that process is already installed' from: "]. 

self session transactionMROW: [ 
| usp | 

usp := UpdateStreamProcessor named: 'Main' inSession: self session, 
index <= usp numberOfContentionSpaces 

ifTrue: [proc := ContentionSpaceProcess new] 

ifFalse: [proc := SaturationTestProducerProcess new]. "Hooked for saturation testing." 
proc initializeForlndex: index, 
self addProcess: proc].! 
install Process Id: anlnteger onHost: hostName 

"Install a consumer or producer process on this machine." 

self send: 'Install process \ anlnteger printString toHost: hostName.! 



lUSPControllerService methodsFor: 'accessing'! 
log: aString from: originatingHost 

"Something interesting has happenned on the given host. Report it to interested parties." 

self changed: #log with: originatingHost •> aString.! 



lUSPControllerService methodsFor: 'private - responder'! 
logEnable: aBoolean 

"USPControllerService current logEnable: true" 

logEnable := aBoolean.! 

i 



lUSPControllerService methodsFor: 'accessing'! 
processAt: id 

processes at: id ifAbsent [n»l]Jj 
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! USPControllerService methodsFor: 'private - responder'! 
removeHost: aString 

(runningHosts includes: aString) ifTrue: [ 
| anyKilled | 

runningHosts remove: aString. 
hostsThatReplied remove: aString. 
anyKilled := false, 
processes values do: [:p | 

p host = aString ifTrue: [ 

p isLocal ifTrue: [p stop]. . 

self removeProcessId: p myld. 

anyKilled := true]]. 
anyKilled ifTrue: [self changed: #status]. 
self changed: #runningHosts].! 



lUSPControllerService methodsFor: 'accessing'! 
removeProcessId: processld 

(processes includesKey: processld) ifTrue: [ 

(processes at: processld) removeDependent: self, 
processes removeKey: processld ifAbsent: []].! 
resetHostsThatReplied 

hostsThatReplied := Set new.! 



!USPControllerService methodsFor: 'private - responder'! 
responderLoop 

"Repeat forever, responding to messages from my peers.' 

| buffer | 

buffer := Byte Array new: 512. 
[ 



[ 



| size msg sock neighbour | 
socket read Wait. 

(sock := socket) isNil ifTrue: [ A self]. 
neighbour := IPSocketAddress new. 
size := sock 

receiveFrom: neighbour 

buffer: buffer 

start: 1 

for: buffer size 
flags: 0. 

msg := (buffer copyFrom: 1 to: size) asString. 
t 

self 

handleMessage: msg 
from: neighbour hostName 
] on: Object errorSignal do: [:ex | 
self 

gr 'HRROR in USPControllerService :' 
%v "\ ex errorString, MM ; 
message = "', msg, "". 
iltshiftDown ifTrue: [self halt]. 




]• 

] repeat. 
] ensure: [responder := nil].! 



! USPControllerService methodsFor: 'accessing 1 ! 
runningHosts 

^nningHosts asSortedCol lection asArray! 
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lUSPControllerService methodsFor: 'private - i/o'! 
send: aString to Host: hostName 

"Send a message to the given host." 

| addr | 

[socket notNil] assert. 

self at: 0 log: 'Send: "', aString, to ', hostName. 
addr := IPSocketAddress 

hostName: hostName 

port: self class magicPort. 

outputLock critical: [ 

outputSocket 

setOptionsLevel: SocketAccessor solSocket 
name: 32 " = SocketAccessor soBroadcast" 
value: 0. "disable broadcasting." 

outputSocket write Wait. 

outputSocket sendTo: addr buffer: aString].! 



lUSPControllerService methodsFor: 'accessing'! 
session 

(session isNil or: [session isOpen not]) ifTrue: [ 
[ 

session :- OoSession open: 'currentdb'. 
session rpcTimeout: 5000; uselndex: true; recover: false. 
] on: Object errorSignal do: [:ex | 

self broadcast: 'Log Exception on "\ SocketAccessor getHostname, "' - \ ex errorString. 

] 

■]- 

A session! 



lUSPControllerService methodsFor: 'startup/shutdown'! 
shutdown 

self stop Responder. 
outputSocket notNil ifTrue: [ 
( 

runningHosts copy do: [:host | 

self removeHost: host], 
self broadcast: 'Shutting down \ SocketAccessor getHostname. 
(Delay forSeconds: 1 ) wait. "Wait for message to be sent." 
] on: Object errorSignal do: [:ex | 
self 

at: 0 log: 'ERROR shutting down USPControllerService:'; 
at: 0 log: ' "', ex errorString, H ". 
ex return. 

]• 

outputSocket close. 
outputSocket := nil], 
socket notNil ifTrue: [ 

[ 

socket close 
] on: Object errorSi gnjfr do: [:ex | 

self at: 0 log: ^RRQR closing responder socket' 

]. 

socket := nil].! 

i 



44 



!USPControllerService methodsFor: 'private - responder'! 
startProcessId: an Integer 

"Start a consumer or producer process on this machine." 

I proc | 

proc := self processAt: an Integer, 
proc isNil ifTrue: [ 

A self broadcast: 'Log Must install before starting'], 
proc isLocal ifFalse: [ 

A self broadcast: 'Log Process start message was incorrectly routed'], 
proc start.! 
startResponder 

[socket notNil] assert, 
self stopResponder. 
responder Process 

forBlock: [self responderLoop] 

priority: Processor userSchedulingPriority + 1 . "Rapid response to short queries" 
responder resume.! 



lUSPControllerService methodsFor: 'startup/shutdown'! 
startup 

"Start me up. Open a socket on my favorite port to listen for datagram messages." 
iaddr| 

self shutdown. 

[socket isNil] assert, 
socket := SocketAccessor 

family: (SocketAddress domainCodeFromName: tfaflnet) 

type: SocketAccessor sockDgram 

protocol: SocketAccessor pfijnspec. 
addr := IPSocketAddress hostName: SocketAccessor getHostname port: self class magicPort. 
[ 

socket bindTo: addr. 
] on: OSErrorHolder existingReferentSignal do: [:ex | 

self at: 0 log: '*** PROBLEM: The magicPort (', self class magicPort printString, ') is currently in use. Waiting 10s before retrying.'. 
(Delay forSeconds: 10) wait, 
ex retry 

J- 

outputSocket notNil ifTrue: [ 
[ 

outputSocket shutdown: 2 
] on: Object errorSignal do: [:ex | 

"Ignore problems in shutdown: method." 
ex return. 

]■ 

outputSocket close]. 
outputSocket := SocketAccessor 

family: (SocketAddress domainCodeFromName: #aflnet) 

type: SocketAccessor sockDgram 

protocol: SocketAccessor pfUnspec. 
addr := IPSocketAddress thisHostAnyPort. 
outputSocket bindTo: addr.^ 

self broadcast: self statusMcssage. 

self startResponder.! 
statusMessage 

| str local Procs | 

str := WriteStream on: (String new: 64). 
str nextPutAll: 'Running on '. 
str nextPutAll: SocketAccessor getHostname. 
localProcs := processes values select: [:proc | 
proc isLocal]. 

(localProcs asSortedCollection: [:a :b | a my Id <= b my Id]) do: [:proc | 

str cr; print: proc my Id; space; nextPutAll: proc statusString]. 
A str contents! 

i 
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lUSPControllerService methodsFor: 'private - responder'! 
stopProcessId: an Integer 

"Stop a consumer or producer process on this machine." 

I proc | 

proc :~ self process At: anlnteger. 
proc isNil ifTrue: [ 

A se1f broadcast: 'Log Must start before stopping'], 
proc isLocal ifFalse: [ 

A self broadcast: 'Log Process stop message was incorrectly routed'], 
proc stop.! 
stopResponder 

IPI 

(p := responder) notNil ifTrue: [p terminate], 
responder := nil.! 
syncTime: hostAndTimeString 

| str host timeString | 

str := hostAndTimeString readStream. 

host := str upTo: Character space. 

host - SocketAccessor getHostname ifTrue: [ 

"Ignore loopback of broadcast, otherwise it'll drift my own clock a little each time." 

A selfj. 

timeString := str upToEnd. 

MiosoftWindowsSupport run DosAnd Wait: 'cmd /c time ', timeString.! 



lUSPControllerService methodsFor: 'accessing'! 
syncToMe 

"Synchronize all clocks to the one on this processor (within about a second)." 
self broadcast: 'Sync to ', SocketAccessor getHostname, ' ', Time now printString! 



Srnalitaik. Applications defmeClass: #JoiiScheduiingFrarnework 
superclass: #{ENVY.Application} 
indexedType: #none 
private: false 

instance VariableNames: " 
classInstanceVariableNames: " 
imports: " 
category: "! 

Smalltalk defmeClass: #UpdateStreamProcessor 
superclass: #{Core.Object} 
indexedType: #none 
private: false 
instanceVariableNames: ' 

numContentionSpaces <uintl6> 

num Writers <uintl6> 

participants <ooVArray(UspParticipant)> ' 
classInstanceVariableNames: " 
imports: " 
category: "! 
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! UpdateStreamProcessor class methods For: 'database creation"! 

createWithName: aString execution: executionCount writers: writerCount fractionBlock: fractionBlock 

"Create an UpdateStreamProcessor with the given information. The USP has a list of executionCount+writerCount 
Participants, the first executionCount of which are mapped to contention spaces. The remainder are non-executing 
participants, used for writing jobs into the USP. The USP will be written in the database 'USP <aString> root'. Each 
participant will be written to a database named 'USP <aString> - <N>\" 
"UpdateStreamProcessor createWithName: 'Main' execution: 2 writers: 1 fractionBlock: [:x |]" 

A self new 

createWithName: aString 
execution: executionCount 
writers: writerCount 
fractionBlock: fractionBlock! 
named: aString 

"Lookup and answer the UpdateStreamProcessor with the given name. Note that this is a transient 
copy to prevent excessive locking. Call this within a transaction (preferrably MROW)." 
"DatabaseSession currentSession transaction MROW: [UpdateStreamProcessor named: 'Main']" 

A self named: aString inSession: DatabaseSession currentSession! 
named: aString inSession: session 

"Lookup and answer the UpdateStreamProcessor with the given name. Note that this is a transient 
copy to prevent excessive locking. Call this within a transaction (preferrably MROW)." 
"DatabaseSession currentSession transactionMROW: [UpdateStreamProcessor named: 'Main']" 

|dbq| 

(session hasDB: 'USP ', aString, ' root') ifFalse: [^il]. 
db := session openDB: 'USP ', aString, ' root', 
q := session 

lookupObj: 'USP' 

inScope: db. 
A q copy! 



! UpdateStreamProcessor class methodsFor: 'private: generated'! 
ooCodeGen Version 

A 1! 

ooTypedlnstanceVariablesString 

A • 

numContentionSpaces <uintl6> 
numWriters <uintl6> 

participants <ooVArray(UspParticipant)> '! 
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! UpdateStreamProcessor methodsFor: 'initial ize-release'! 

createWithName: aString execution: executionCount writers: writerCount fractionBlock: fractionBIock 

"Create an UpdateStreamProcessor with the given information. The USP has a list of executionCount+writerCount 
Participants, the first executionCount of which are mapped to contention spaces. The remainder are non-executing 
participants, used for writing jobs into the USP. The USP will be written in the database 'USP <aString> root'. Each 
participant will be written to a database named "USP <aString> participant <N>'." 

| session total | 

numContentionSpaces := executionCount. 
numWriters writerCount. 
total := writerCount + executionCount. 
participants := OoVArray new: total, 
session := DatabaseSession currentSession. 
session transaction: [ 

| rootDB rootContainer | 

rootDB := session newDB: 'USP \ aString, ' root'. 
rootContainer := rootDB newCPPContainer: 'USP Root container'. 
rootContainer cluster: self. 
fractionBlock value: 1 / (total + 1 ). 

1 to: total do: [:count | 

| isContentionSpace participant participahtDB participantCon | 
isContentionSpace := count <= executionCount. 
isContentionSpace 
ifTrue: [ 

participant := Contention Space new 
initialized: count 
participants: total 
consumers: numContentionSpaces 
hostName: " 
port: 13794] 

ifFalse: [ 

participant := UspParticipant new 
initialized: count 
participants: total 
consumers: numContentionSpaces 
hostName: "]. 

participantDB := session newDB: 'USP ', aString, ' - ', count printString. 
participantCon := participantDB newCPPContainer: 'USP Participant container'. 
participantCon cluster: participant, 
participants at: count put: participant. 
fractionBlock value: (count + 1) / (total + 1)]. 

"Name the scheduler." 
session 

nameObj: self 

with: 'USP' 

inScope: rootDB. 

J. 

A self! 



! UpdateStreamProcessor methodsFor: 'accessing'! 
numberOfContentionSpaces 

NumContentionSpaces! m V 
numberOfParticipants -;- 

NumContentionSpaces + numWriters! 
participantAt: index 

participants at: index! 



! UpdateStreamProcessor methodsFor: 'copying'! 
postCopy 

super postCopy. 

participants := participants copy.! 
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Smalltalk defineClass: #UspParticipant 
superclass: #{ Core .Object} 
indexedType: #none 
private: false 
instanceVariableNames: ' 
id <uintl6> 

hostName <ooVString> 

outputBuffers <ooVArTay(ooShortRefl[JobBufTer))> 

uniquenessCounter <uint64> 

numberOfParticipants <uint!6> * 
class InstanceVariableNames: " 
imports: " 
category: "! 



!Usp Participant class methodsFor: 'private: generated'! 
ooCodeGen Version 



Ml 

ooTyped Instance VariablesString 



id <uintl6> 

hostName <ooVString> 

outputBuffers <ooVArray(ooShortRefl[JobBufTer))> 
uniquenessCounter <uint64> 
numberOfParticipants <uint!6> *! 



lUspParticipant methodsFor: 'ui support'! 
assignments tring 

. |str| 

str := WriteStream on: (String new: 64). 
str nextPutAll: 'Currently assigned to '. 

strnextPutAll: (hostName isNil ifTrue: ['(nil)'] ifFalse: [hostName]). 
A str contents! 
dumpStatusOn: str 

str nextPutAll: 'Pro#*; print: id.! 



lUspParticipant methodsFor: 'accessing'! 
hostName 

A hostName! 



lUspParticipant methodsFor: 'initialize -release'! 

initialized: myld participants: totalCount consumers: consumers hostName: myHost 
id := myld. 

outputBuffers := OoV Array new: consumers. 
1 to: consumers do: [:i | 

outputBuffers at: i put self jobBufferClass new]. 
uniquenessCounter := myldg;g 
numberOfParticipants := tol|feount 
hostName := myHost.! sj&fr 

i 



lUspParticipant methodsFor: 'accessing'! 
jobBufferClass 

self ooClass = UspParticipant ifTrue: [ A SaturationTesUobBuffer]. 
MobBuffer! 

myld 

A id! 

numberOfContentionSpaces 
A outputBuffers size! 
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numberOfParticipants 

A numberO {Participants ! 
outputBu tiers 

A outputBuffers! 



lUspParticipant methodsFor: 'ui support'! 
resetAHJobs 

"This is extremely dangerous, and is only to be used for testing. Remove all jobs, and reset 
the job numbering of my output buffers. " 

outputBuffers do: [:buffer | 
buffer resetAH Jobs].! 



lUspParticipant methodsFor: 'accessing'! 
setHostName: newHostName 

hostName :- newHostName.! 

i 



!UspParticipant methodsFor: 'ui support'! 
statusString 

|str| 

str := WriteStream on: (String new: 64). 
self dumpStatusOn: str. 
A str contents! 

i 



Smalltalk deflneClass: #ContentionSpace 
superclass: #{Usp Participant} 
indexedType: #none 
private: false 
instance VariableNames: ' 
port<uint!6> 

lasUobsExecuted <ooVArray(uint32)> 
runningJob <ooShortRef(Job)> 
runningTaglnteger <uint64> 

waitingSyncJobs <ooShortRefi(OrderedCollection)> ' 
classlnstanceVariableNames: " 
imports: " 
category: "! 



!ContentionSpace class methodsFor: 'private: generated'! 
ooCodeGen Version 

A 1! 

ooTypedlnstanceVariablesString 

A » 

port<uintl6> 

lasUobsExecuted <ooVAiray(uint32)> 
runningJob <ooShortRcf(Job>> 
runningTaglnteger <uint64> 
waitingSyncJobs <ooShortRef[OrderedCoUection)> M 

t 
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!ContentionSpace methodsFor: 'ui support'! 
assignments tring 



| sir | 

str := WriteStream on: (String new: 64). 
str nextPutAll: "Currently assigned to 
str nextPutAll: hostName, '@\ port printString. 
A str contents! 
dumpStatusOn: str 

str nextPutAll: 'Con#'; print: id. 

str nextPutAll: \ host='; nextPutAll: hostName. 

str nextPutAll: port=*; print: port. 

str nextPutAll: '.'.! 



!ContentionSpace methodsFor: 'initialize-release'! 

initializeld: myld participants: totalCount consumers: consumers hostName: myHost port: myPort 
self initialized: myld participants: totalCount consumers: consumers hostName: myHost. 
port := myPort. 

lasUobsExecuted := OoV Array new: totalCount withAll: 0. 

runningJob :- nil. 

runningTaglnteger := 0. 

waitingSyhcJobs := OrderedCollection new.! 



IContentionSpace methodsFor: 'accessing'! 
lasUobsExecuted 

A lasUobsExecuted! 
nextUnique Integer 

"Answer an integer that is unique for this row. Use a 64-bit counter, which will 
repeat every 18 million million million elements or so. At a billion allocations a second 
(a ridiculous overestimate), this would still last > 580 years before repeating. Of 
course, we should temper this with the fact that every row and column has a 
unique modulus in this huge set. Thus, if there are 1000 rows and 3000 columns 
(a very large scale application, indeed), the integers would cycle approximately 
every 580/4000.0 = — 1 /7th of a year. Of course, the combined computation would 
have to be exceeding four trillion allocations a second! ! Anyhow, as long as old 
jobs get processed before these counters wrap around - no problem. Note that 
this method dirties this ContentionSpace, so it should only be used when the 
ContentionSpace is already write-locked." 

uniquenessCounter := uniquenessCounter + numberOfParticipants. 
uniquenessCounter basicSize > 8 ifTrue: [ 
"8 bytes = 64 bits." 

"Avoid ever returning zero, as that is used to indicate unsynchronized Job execution." 
uniquenessCounter := (uniquenessCounter - 1) \\ numberOfParticipants + 1]. 
A uniquenessCounter! 



port . 



A port! 
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!ContentionSpace methodsFor: 'ui support'! 
reseiAHJobs 

"This is extremely dangerous, and is only to be used for testing. Remove all jobs, and reset 
the job numbering of my output buffers." 

super resetAUJobs. 

[waitingSyncJobs isEmpty] whileFalse: [ 

waitingSyncJobs removeFirst ooDelete]. 

runningjob = nil ifFalse: [ 
runningJob ooDelete. 
runningjob := nil]. 

lasUobs Executed atAUPut: 0. 

runningTaglnteger := 0.! 



IContentionSpace methodsFor: 'accessing'! 
runningJob 

A runningJob! 
runningJob: aJob 

runningJob := aJob.! 
runningTag 

"Answer a (lightweight) JobSynchronizationTag that is used to identify jobs that 
must be synchronized together. Answer nil if a synchronized group is not active." 

runningTaglnteger — 0 ifTrue: ["nil]. 

MobSynchronizationTag new fromlnteger: runningTaglnteger! 
runningTag: aJobSynchronizationTagOrNil 

"Set my curren tag. This indicates that in the case of recovery we should execute 
jobs that have this tag right after the currenUob (if any) completes." 

aJobSynchronizationTagOrNil isNil 
ifTrue: [runningTaglnteger :- 0] 

ifFalse: [runningTaglnteger := aJobSynchronizationTagOrNil taglnteger]! 
setHostName: newHostName port: newPort 

hostName := newHostName. 
port := newPort.! 
waitingSyncJobs 

A waitingSyncJobs! 

i 
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Smalltalk defineClass: #Query 
superclass: # {Formula} 
indexedType: #none 
private: false 
instanceVariableNames: ' 

autoCreate <boolean> 

index <Index>' 
classInstanceVariableNames: " 
imports: " 

category: 'ENVY/Manager*! 



IQuery class methodsFor: 'private: generated'! 
ooCodeGenVersion 

A 1! 

ooTyped Instance VariablesString 

A I 

autoCreate <boolean> 
index <Index>'! 

! 

Smalltalk defineClass: #IndexEntry 
superclass: #{Core.Object} 
indexedType: #none 
private: false 
instanceVariableNames: ' 

indexedObject <Object> ' . 
classInstanceVariableNames: 'cachedlndex ' 
imports: " 

category: 'ENVY/Manager'! 

! IndexEntry class methodsFor: 'class accessing'! 
cachelndexIfNilForSession: aSession 

"Cache my index if it's nil. Must be called within an MROW transaction of aSession, otherwise 
it might lock the System container, which could be a Bad Thing." 

| schema els ind | 

cachedlndex notNil ifTrue: [ A cachedlndex]. 
schema := (MioSystem currentPersistent: aSession) schema, 
els := schema schemaClassNamed: self rootClassName. 
ind := els indices 

detect: [:eachlnd | eachlnd name = self indexName] 

ifNone: [self error: 'The index for this IndexEntry no longer exists in the schema*], 
cachedlndex := ind deepCopyCreatingHomomorphism: IdentityDictionary new. 
A cachedlndex! 

i 



! IndexEntry class methodsFor: 'class initialization'! 
clearCachedlndices 

cachedlndex := nil.! 



! IndexEntry class methodsFor 'cl^jaccessing'! 

index fsf' 

"Answer the instance of Ind&ftnr which I represent an entry. The cache 
must have already been set up via cachelndexIfNilForSession: first." 

cachedlndex isNil ifTrue: [ 

self error: 'Make sure to call cachelndexIfNilForSession: first.*]. 
A cachedlndex! 
indexName 

"Answer the name of the Index for which I represent instances." 

self oolsPersistent ifTrue: ^superclass indexName]. 
A self fullName readStream upTo: $_; upToEnd! 

i 
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UndexEntry class methodsFor: 'class initialization'! 
initialize 

self withA US ubclassesDo: [:cls| 
ds clearCachedlndices].! 



UndexEntry class methodsFor: 'instance creation"! 
new 

A supernew initialize! 



MndexEntry class methodsFor: 'private: generated'! 
ooCodeGenVersion 

A 1! 

ooTypedlnstanceVariablesString 

A I 

indexedObject <Object> '! 



!IndexEntry class methodsFor: 'class accessing*! 
rootClassName 

"Answer the name of the root class for which I represent instances." 

self oolsPersistent itTrue: ^superclass rootClassName]. 
A self fullName readStream upTo: $_! 



MndexEntry methodsFor: 'accessing'! 
contentionlndex 

"Answer the contention space that I should be in. Since this was assigned randomly to the index's 
containers during index creation, we must defer to the index to figure this out." 

A self ooClass index contentionSpaceFor: self! 



UndexEntry methodsFor: 'comparing'! 
hashOfKey 

"Answer a hash of just my key information." 

self subclassResponsibility.! 
hasSameKeyAs: another 

"Answer whether my key information matches another's key information." 

[self ooClass = another ooClass] assert, 
self subclassResponsibility.! 

t 

UndexEntry methodsFor: 'accestp^;;^ 
indexedObject ^fi?T' 

A indexedObject! 
indexedObject: anObject 

indexedObject :- anObject! 

I 



!IndexEntry methodsFor: 'initialize-release'! 
initialize 

"Subclasses will do more." 

A self! 

t 
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UndexEntry methodsFor: 'accessing'! 
key 

"IndexEntry Key fromlndexEntry: self! 
targetContainerin: session 

"Answer the OoContainer in which to insert this Index Entry." 

A ((self ooClass cachelndexIfNilForSession: session) 
containerFor: self inSession: session 
) ooContainer! 



Smalltalk defineClass: #Index Entry Key 
superclass: #{Core.Object} 
indexedType: #none 
private: false 

instance VariableNames: 'index Entry ' 
classInstanceVariableNames: " 
imports: " 

category: 'ENVY/Manager'! 



! Index En try Key class methodsFor: 'instance creation'! 
fromlndexEntry: anlndexEntry 

A se1f new indexEntry: anlndexEntry! 



! Index En try Key methodsFor: 'comparing'! 
= another 

"Compare this index entry key to the other one." 

another assertType: Index Entry Key. "Safety precaution for now" 

indexEntry ooClass = another indexEntry ooClass ifFalse: [ A false]. "Different kinds of index entries" 
A indexEntry hasSame Key As: another indexEntry! 

hash 

"Answer this key's hash value." 
A indexEntry hashOfKey! 



superclass: #{ Core. Object 
indexedType: #none 
private: false 
instance VariableNames: " 
classInstanceVariableNames: " 
imports: " 

category: 'ENVY/Manager'! 



! Index Entry Key methodsFor: 'accessing'! 
indexEntry 



A indexEntry! 



UndexEntryKey methodsFor: 'initialization'! 
indexEntry: anlndexEntry 



indexEntry := anlndexEntry.! 
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!IndexEntry Tracker methodsFor: 'accessing'! 

checkForPendingRequestsForObject: object contentionSpaceProcess: aContentionSpaceProcess contentionlndex: contentionlndex 

[object isStable not] assert, 
object is Deleting ifTrue: [ 

Tve just finished deleting all my index entries in preparation for my own deletion. 

Since I have already long since disconnected my change node and sent it a reply 

indicating this fact, I should not send it any message (I can't anyhow, since my 

pointer to it was already cleared)." 

[object locallndexEntries isEmpty & object remotelndexEntries isEmpty] assert. 

object delete. 

A self|. 

[object isReindexing] assert, 
object beStable. 

object hasRequestedDeletion ifTrue: [ 
| tag remote Entries local Entries | 
object clear Requests; be Deleting, 
tag := aContentionSpaceProcess nextUniquelnteger. 
remoteEntries := object remotelndexEntries. 
remoteEntries isEmpty 

ifTrue: [object delete] 

iflFalse: [ 

localEntries := object locallndexEntries. 

[localEntries size = remoteEntries size] assert. 

localEntries with: remoteEntries do: [:localEntry :remoteEntry | 

localEntry ooClass cachelndexlfNilForSession: aContentionSpaceProcess session. 
aContentionSpaceProcess add Job: (IndexEntryDeleteJob new 
contentionlndex: localEntry contentionlndex; 
indexedObject: object; 
indexEntry: remoteEntry; 
replyTag: tag; 

replyQuorumDenominator: localEntries size; 

objectContention Index: contentionlndex). 
localEntry ooDelete]. 
self locallndexEntries: Array new. 
self remotelndexEntries: Array new]. 

A self). 

object hasRequestedReindexing ifTrue: [ 

"An indexing was requested while my previous indexing was being done. Start reindexing once again." 
[object locallndexEntries size = object remotelndexEntries size] assert, 
object clearRequests. 
self 

contentionSpaceProcess: aContentionSpaceProcess 
object: object 

objectContention Index: contentionlndex 
oldTransientsIfKnown: object locallndexEntries. 
A self). 

"The object just became stable. Delete its local index entries, as these can now be computed from the object itself." 
object locallndexEntries do: [:ie | ie ooDelete]. 
object locallndexEntries: Array new.! 
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contentionSpaceProcess: aContentionSpaceProcess object: object objectContention Index: objectContentionlndex oldTransientsIfKnown: oldTransientsOrNil 
"The old object has just been replaced with the new object. Create index entry update jobs. Note that 
the old and new object may share parts, and the old object may have been partially deleted already 
at this point. If the list of oldTransients (IndexEntries) is provided, it is assumed that these were extracted 
from the old object before it was destroyed. If no oldTransients are provided, they must be present in the 
local IndexEntries instance variable. We must be in a transaction. If any jobs are scheduled (which will 
eventually reply to the object), set the object's isReindexing flag." 

| oldTransients oldTransientsToSubscripts newTransients remoteEntries newMixed oldKeysToSubscripts typesAndContentionToSubscripts quorum 
resultingEntries replyTag | 
[object isStable] assert. 

remoteEntries := object remotelndexEntries. 
oldTransientsOrNil isNil 
ifTrue: [ 

"This means the object was already changed back when the object's indexes were in the 

process of being updated (for a *previous* change). Now we're playing catch-up, but the 

local and remote index entries will still agree. Therefore, use the local entries to figure out 

which remote entries need to be updated in which ways." 
oldTransients := object locallndexEntries] 
ifFalse: [ 

"In this case the object has not changed since the previous indexing *started*. The passed 
list of transient index entries should agree with the current persistent entries. This will save 
us having to actually read the remote persistent index entries in this process." 
oldTransients := oldTransientsOrNil]. 

[oldTransients size = remoteEntries size] assert: The object's index entries are invalid'. 

"At this point oldTransients agrees structurally with remoteEntries, the list of current persistent IndexEntries 

connected to the object." . 

oldTransientsToSubscripts := Dictionary new. 
1 to: oldTransients size do: [:i | 
I list | 

list := oldTransientsToSubscripts at: (oldTransients at: i) ifAbsentPut: [OrderedCollection new], 
list add: i]. 

"First try to reuse persistent index entries that exactly match the new ones..." 
newTransients := object trans ientlndexEn tries. 
newMixed := newTransients collect: [:newTrans | 
| subs | 

subs := oldTransientsToSubscripts at: newTrans ifAbsent: [#()]. 
subs notEmpty 
ifTrue: [ 

"Use an existing persistent one that's just like it." 
#oldUnchanged -> (remoteEntries at: subs removeFirst)] 
ifFalse: [ 

#maybeNew -> newTrans]]. 

"In preparation for what follows, ensure all Index information has been cached. This just includes 
information about which hash value goes to which index container, and what contention space it's in." 
oldTransients do: [:trans | 

trans ooClass cachelndexIfNilForSession: aContentionSpaceProcess session]. 
newTransients do: [: trans | 

trans ooClass cachelndexIfNilForSession: aContentionSpaceProcess session]. 

"Now try to reuse unclaimed persistent index entries that have the same keys as new ones..." 
oldKeysToSubscripts := Dictionary new. 
oldTransientsToSubscripts keysAndValuesDo: [roldTrans :subs | 
subs size > 0 ifTrue: 
| list | 

list := oldKeysToSubscripts at: oldTrans key ifAbsentPut: [OrderedCollection new], 
list addAll: subs]]. 
newMixed := newMixed collect: [:newAssoc | 
newAssoc key = #maybeNew 
ifTrue: [ 

| newTrans newTransKey subs | 
newTrans := newAssoc value. 
newTransKey := newTrans key. 

subs := oldKeysToSubscripts at: newTransKey ifAbsent: [#()]. 
subs notEmpty 
ifTrue: [ 
| sub | 

sub := subs removeFirst. 

#oldChanged -> (Array with: (remoteEntries at: sub) with: (oldTransients at: sub) with: newTrans)] 
ifFalse: [ 

newAssoc]] 
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ifFalse: [newAssoc]]. 

"As a final optimization, attempt to recycle index entries with merely the correct ooClass and contention space..." 
typesAndContentionToSubscripts := Dictionary new. 
oldKeysToSubscripts keysAndValuesDo: [mewTransKey :subs | 
subs do: [:sub | 

| contention pair list | 

contention := (oldTransients at: sub) contentionlndex. 
pair := Array with: newTransKey indexEntry ooClass with: contention, 
list := typesAndContentionToSubscripts at: pair ifAbsentPut: [OrderedCol lection new], 
list add: sub]]. 
newMixed := newMixed collect: [:newAssoc | 
newAssoc key - #maybeNew 
ifTrue: [ 

| newTrans contention pair subs | 
newTrans := newAssoc value, 
contention :» newTrans contentionlndex. 
pair := Array with: newTrans ooClass with: contention, 
subs typesAndContentionToSubscripts at: pair ifAbsent: [#()]. 
subs notEmpty 
ifTrue: [ 
I sub | 

sub subs removeFirst. 

floldChanged -> (Array with: (remoteEntries at: sub) with: (oldTransients at: sub) with: newTrans)] 
ifFalse: [ 

#newEntry -> (Array with: newTrans)]] 
ifFalse: [newAssoc]]. 

"Now create the actual jobs to carry out this plan. Start by deleting unrecycleable IndexEntries..." 
quorum :«■ (newMixed select: [rassoc | assoc key — #oldUnchanged]) size. 
typesAndContentionToSubscripts do: [:subs | 

quorum := quorum + subs size], 
quorum > 0 ifTrue: [ 

object beReindexing. 

replyTag := aContentionSpaceProcess nextUniquelnteger]. 
typesAndContentionToSubscripts keysAndValuesDo: [:pair :subs | 
subs do: [:sub | 
I job | 

job := IndexEntry DeleteJob new 

contentionlndex: pair last; 

indexedObject: object; 

indexEntry: (remoteEntries at: sub); 

replyTag: replyTag; 

replyQuorumDenominator: quorum; 

objectContentionlndex : objectContentionlndex. 
aContentionSpaceProcess addJob: job]]. 

"Deal with the new and recycled index entries... " 
resultingEntries := OrderedCol lection new: newMixed size. 
1 to: newMixed size do: [subscript | 
| newAssoc value | 

newAssoc := newMixed at: subscript, 
value := newAssoc value. 
(Case of: newAssoc key) 

if: [#oldUnchanged] do: [ 

"Do nothing - the index entry is still valid..." 

resultingEntries add: value]; 
if: [#oldChange4J^| 

"The entrySp^tention space is the same, but its data has changed..." 

| oldPersi^BT^ns new job | 

oldPersiM^ratoie at: 1. 

oldTrans := value at: 2. 

new := value at: 3. 

object ooCluster: new. "Until it's deleted in a reply job." 
job := IndexEntryUpdateJob new 

contentionlndex: oldTrans contentionlndex; 

index En try ToUpdate: oldPersist; 

newIndexEntryData: new; 

replyContentionlndex: objectContentionlndex; 

replyQuorumDenominator: quorum; 

replyTag: replyTag. 
aContentionSpaceProcess addJob: job. 
resultingEntries add: oldPersist]; 
if: [#newEntry] do: [ 

"Create a new index entry..." 
| new job | 
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new := value first. 

object ooCluster: new. "Until it's deleted in a reply job." 
job :- Index En try AddJob new 

indexEntry: value first; 

subscript: subscript; 

replyContention Index: objectContentionlndex; 
replyQuorumDenominator: quorum; 
replyTag: replyTag. 
aContentiohSpaceProcess addJob: job. 

"Since the actual index entry does not yet exist, just refer to the temporary one." 
resultingEn tries add: nil]; 
else: [self error: 'Unrecognized index entry update mode']], 
object remotelndexEntries: resultingEntries. 
oldTransients do: [:ie | 

ie oolsPersistent ifTrue: [ie ooDelete]]. 
object local IndexEntries: newTransients.! 



Smalltalk defineClass: #IndexObserver 
superclass: #{Core.Object} 
indexedType: #none 
private: false 

instance VariableNames: " 
classInstanceVariableNames: " 
imports: " 

category: 'ENVY/Manager'! 



UndexObserver methodsFor: 'notification*! 
index: anlndex hasAdded: anlndexEntry 
self implementedBySubclass! 



Smalltalk defineClass: #AbstractSetFieldJob 

superclass: #{OneStepJob} 

indexedType: #none 

private: false 

instance VariableNames: ' 
object <Object> 
rootObject <Object> 
fieldName <ooVString> ' 

classInstanceVariableNames: " 

imports: " 

category: "! 



!AbstractSetFieldJob class methodsFor: 'private: generated'! 
ooCodeGenVersion 

A 1! 

ooTyped Instance VariablesString 

A < 

object <Object> 
rootObject <Object> 
fieldName <ooVString> '! . 
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!AbstractSetFieldJob methodsFor: 'execution'! 
executeWith: aContentionSpaceProcess 

"Make the required change to object, causing rootObject to be reindexed (as necessary)." 

rootObject isStable 
ifTrue: [ 

| oldTransients | 

oldTransients := rootObject transientlndexEntries. 
object perform: fieldName with: s^lf value. 
IndexEntry Tracker new 

contentionSpaceProcess: aContentionSpaceProcess 

object: rootObject 

objectContentionlndex: aContentionSpaceProcess myld 
oldTransientsIfKnown: oldTransients] 

ifFalse: { 

rootObject isDeleting ifTrue: [ A self]. "Ignore changes to doomed objects." 
[rootObject isReindexing] assert, "not stable means either deleting or reindexing." 
"The reindexing will happen after the current reindexing completes." 
object perform: fieldName with: self value. 
rootObject requestReindexing].! 



!AbstractSetFieldJob methodsFor: 'accessing'! 
fieldName: aSymbol 

aSymbol assertType: Symbol. 
aSymbol last - $: ifFalse: [ 

self error: 'The fieldName must be a one-argument selector']. 
fieldName := aSymbol.! 
object: anObject 

anObject class oolsPersistent itFalse: [ 

self error: The object must already have been clustered (or persistent)'], 
object := anObject.! 



!AbstractSetFieldJob methodsFor: 'oo-persistence'! 

oolnitializeAfterRead 

"Sent immediately after the receiver is read from the database. You can override 
this method to initialize the receiver after reading it. The object returned by 
this method is ignored." 

fieldName := fieldName asSymbol. 
A super oolnitializeAfterRead! 



!AbstractSetFieldJob methodsFor: 'accessing'! 
rootObject: anObject 

anObject class oolsPersistent ifFalse: [ 

self error: 'The rootObject must already have been clustered (or persistent)']. 
rootObject :- anObject.! 

i 

Smalltalk defmeClass: #SetFieWToOidJob 
superclass: #{AbstractSetFiel&Job} 
indexedType: #none 
private: false 
instance VariableNames: * 

value <Object> ' 
classlnstance VariableNames: " 
imports: " 
category: "! 
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!SetFieldToOidJob class methodsFor: 'private: generated'! 
ooCodeGenVersion 

A J, 

ooTypedlnstanceVariablesString 

A • 

value <Object> '! 



ISetFieldToOidJob methodsFor: 'accessing 1 ! 
value 

A value! 
value: aPersistentObject 

aPersistentObject class oolsPersistent ifFalse: [ 

self error: This object must already be clustered (or fully persistent)*], 
value := aPersistentObject.! 



Smalltalk defineClass: #SetFieldToStringJob 

superclass: #{AbstractSetFieldJob} 
indexedType: #none 
private: false 
instance VariableNames: ' 
value <ooVString> ' 
classInstanceVariableNames: " 
imports: " 
category: "! 



ISetFieldToStringJob class methodsFor: 'private: generated'! 
ooCodeGenVersion 

A 1! 

ooTypedlnstanceVariablesString 

A • 

value <ooVString> '! 



.'SetFieldToStringJob methodsFor: 'accessing'! 
value 

A value! 
value: aString 

aString assertType: String, 
value := aString.! 

j 

Smalltalk defineClass: #SetFieldToVaIueJob 
superclass: # { AbstractSetFfckUob} 
indexedType: #none .-Jgp 
private: false 
instance VariableNames: ' 

value <ooShortRef(Object)> ' 
classInstanceVariableNames: M 
imports: " 
category: H ! 

'.SetFieldToValueJob class methodsFor: 'private: generated'! 
ooCodeGenVersion 

A 1! 

ooTypedlnstanceVariablesString 

A » 

value <ooShortRefTObject)> *! 
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!SetFieldToValueJob methodsFor: 'deleting'! 
oo Delete 

value ooDelete. 
super ooDelete.! 



!SetFieldToValueJob methodsFor: 'copying'! 
postCopy 

super postCopy. 
value := value copy.! 



!SetFieldToValueJob methodsFor. 'accessing*! 
value 

A value! 
value: anObject 

"This will be sent *by value* to the contention space that will execute it." 
value := anObject.! 



Smalltalk defineClass: #CreateFakeObjectsJob 
superclass: #{OneStepJob} 
indexedType: #none 
private: false 
instanceVariableNames: ' 

count <uint32> ' 
classInstanceVariableNames: " 
imports: " 
category: "! 

ICreateFakeObjectsJob class methodsFor: 'class accessing'! 
addRootObject: aRootObject 

"Add the root object to my collection of all root objects." 

AURootObjects addLast: aRootObject.! 
clearAHRoots 

"Empty my collection of root objects." 

[AURootObjects isEmpty] whileFalse: [AURootObjects removeFirst].! 

i 



!CreateFakeObjectsJob class methodsFor: 'class initialization*! 
initialize 

AURootObjects := OrderedCollection new.! 

i 



ICreateFakeObjectsJob class methodsFor: *private: generated'! 
ooCodeGen Version 

A 1! 

ooTyped Instance VariablesString 

A I 

count <uint32> '! 

i 



62 



ICreateFakeObjectsJob class methods For: 'class accessing'! 

pickProductUsing: subscript contentionSpaceProcess: aContentionSpaceProcess 



| prod con obj | 

AURootObjects size = 0 ifTrue: [ 

self recacheRootObjects For: aContentionSpaceProcess]. 
prod := AURootObjects at: subscript \\ AURootObjects size + 1 . 
con := aContentionSpaceProcess session 

ooProvideContainerFor: prod ooContainer ooPrivateContainer ooContainerNumber 

with: prod ooObjectNumber. 
obj := con ooProvideObject: prod ooObjectNumber. 
A obj! 
randomString 

| str rnd | 

rnd := BouncingJob random. 

str := String new: (md next * 1 0) truncated + 5. 

str at: 1 put: (Character value: (md next * 26) truncated + $A aslnteger). 

2 to: str size do: [:i | 

str at: i put: (Character value: (md next * 26) truncated + $a aslnteger)]. 

A str! 

recacheRootObjectsFor: aContentionSpaceProcess 

"Regenerate my cached collection of products from the database." 

| session dbName db scan | 

session := aContentionSpaceProcess session. 

selfclearAHRoots. 

dbName := Telecom_Person - \ aContentionSpaceProcess myld printString. 
db := session openDB: dbName. 
scan := db scan: Telecom_Person. 
[scan atEnd] whileFalse: [ 

self addRootObject: scan next].! 



ICreateFakeObjectsJob class methodsFor: 'EM-Intemal'! 
_PRAGMA_ 

"(defineStatic: #AllRootObjects private: false constant: false category: 'As yet unclassified' initializer: 



ICreateFakeObjectsJob methodsFor: 'accessing'! 
count: anlnteger 

count := anlnteger.! 

i 
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!CreateFakeObjectsJob methodsFor: 'execution'! 
executeWith: aContentionSpaceProcess 

"Create the required number of Products, filled with random strings and numbers." 

| session dbName db con | 

session := aContentionSpaceProcess session. 

dbName := Telecorn_Person - *, aContentionSpaceProcess my Id printString. 
(session hasDB: dbName) 

ifTrue: [db := session openDB: dbName] 
ifFalse: [ 

| systemName path | 

systemName := session systemName. 

path := MioSystem defaultDatabasePath, dbName, systemName, '.DB'. 
db := session 

newDB: dbName 

defaultContPages: 0 

growth: 0 

host: SocketAccessor getHostname 
path: path], 
(db hasContainer: dbName) 

ifTrue: [con := db openContainer: dbName] 
ifFalse: [con := db newContainer: dbName]. 
count timesRepeat: [ 

| person name addr acct billAddr loc line plan | 

person := Telecom_Person new. 

name TelecomJMame new. 

acct := TeIecom_Account new. 

addr := Telecom_Address new. 

billAddr := Telecom_Address new. 

loc := Telecom_Address new. 

line := TelecomJLine new. 

plan := Telecom_FlatRatePlan new. 

person 

birthDate: Date today; 
email: *nobody@there.com'; 

ssn: (BouncingJob random next * 499999999.0) truncated + 1; 
addAddress: addr; 
name: name; 
addAccount: acct. 

name 

first: self class randomString; 
middle: self class randomString; 
last: self class randomString. 

acct 

accountNumber: (BouncingJob random next * 999999.0) truncated + 1 ; 

add Line: line; 

billingAddress: billAddr; 

billingMethod: Telecom_MonthlyInvoice new. 

addr 

country: self class randomString; 
state: self class randomString; 
city: self class randomString; 
street: self class randomString; 
postalCode: self class randomString. 
billAddr 

country: self class randomString; 
state: self class nfodomStrmg; 
city: self class itodmnString; 
street: self class^p^DrtiString; 
postalCode: self dass randomString. 

loc 

country: self class randomString; 
state: self class randomString; 
city: self class randomString; 
street: self class randomString; 
postalCode: self class randomString. 

line 

number: (BouncingJob random next * 9999999999.0) truncated + 1 ; 
addPlan: plan; 
location: loc. 
person clusterWith: con. 

self class addRootObject: person. "For the test harness" 
"Send jobs to create index entries for this new product." 
IndexEntryTracker new 
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contentionSpaceProcess: aContentionSpaceProccss 
object: person 

objectContentionlndex: contentionlndex 
oldTransientsIfKnown: #(). 

].! 



Smalltalk defineClass: #DeleteProductsJob 

superclass: #{OneStepJob} 
indexedType: #none 
private: false 
instanceVariableNames: " 
classInstanceVariableNames: " 
imports: " 
category: "! 



IDeleteProductsJob methodsFor: 'execution'! 
executeWith: aContentionSpaceProcess 

"Delete all Products from this contention space." 

| session dbName db scan | 

session := aContentionSpaceProcess session. 

dbName := Telecom_Person - *, aContentionSpaceProcess myld printString. 
db := session openDB: dbName. 
scan := db scan: Telecom_Person. 
[scan atEnd] whileFalse: [ 

| prod local Entries remote Entries | 

prod := scan next. 

localEntries := prod localOrTransientlndexEntries. 
remote En tries := prod remote IndexEn tries. 
prodisStable 
ifTrue: [ 

[localEntries size = remoteEntries size] assert, 
remote Entries isEmpty 

ifTrue: [prod delete] 

ifFalse: [ 
I tag | 

tag :- aContentionSpaceProcess nextUniquelnteger. 
localEntries with: remoteEntries do: [: local Entry :remoteEntry | 

localEntry ooClass cachelndexlfNilForSession: aContentionSpaceProcess session. 
aContentionSpaceProcess addJob: (IndexEntryDeleteJob new 
contentionlndex: localEntry contentionlndex; 
indexedObject: prod; 
indexEntry: remoteEntry; 
replyTag: tag; 

replyQuorumDenominator: localEntries size; 
obj ectContention Index : contentionlndex)] . 
prod beDeleting. 

prod locallndexEntries: Array new. 
prod remote IndexEntries: Array new]] 

ifFalse: [ 

prod isDeleting ifFalse: [ 
prod requestDeletion]]. 

)• 

CreateFakeObjectsJob clear All Roots.! 



Smalltalk defineClass: #EstabiUhM^ 

superclass: #{OneStepJob}^-: 

indexedType: #none 

private: false 

instanceVariableNames: ' 

indexedObject <Object> 
subscripts <ooVArray(uint32)> 
indexEntries <ooVArray( Index En try )> 
tempIndexEntriesToDelete <ooVArray(IndexEntry)> ' 

classInstanceVariableNames: " 

imports: " 

category: 'ENVY/ManagerV 
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lEstablishMultipleLinksToIndexEntriesWithCleanupJob class methodsFor: 'private: generated'! 
ooCodeGenVersion 

A 1! 

ooTyped Instance VariablesString 

A t 

indexedObject <Object> 
subscripts <ooVArray(uint32)> 
indexEntries <ooVArray(lndexEntry)> 
tempIndexEntriesToDelete <ooVArray( Index Entry )> '! 



lEstablishMultipleLinksToIndexEntriesWithCleanupJob methodsFor: 'accessing'! 
addlndexEntryToDelete: templndex Entry 

tempIndexEntriesToDelete addElement: tempIndexEntry.! 
addSubscript: subscript newIndexEntry: newIndexEntry 

subscripts addElement: subscript. 
indexEntries addElement: newIndexEntry.! 



!EstablishMultipleLinksToIndexEntriesWithCleanupJob methodsFor: 'execution'! 

execute With: aContentionSpaceProcess 

"Update the given subscripts of my indexed object's list of index entries to point 
to the freshly constructed index entries. Also delete the temporary index entries. 
Also start a reindex or delete operation based on the object's requestFlag." 

[subscripts size = indexEntries size] assert. 

subscripts with: indexEntries do: [:i :entry | 

indexedObject remotelndexEntries at: i put: entry]. 

tempIndexEntriesToDelete do: [:entry | entry ooDelete]." "Ignore - I've changed this mechanism" 
[tempIndexEntriesToDelete all: [:entry | 

indexedObject locallndexEntries any: [:localEntry | localEntry — entry]]. 
] assert. 

IndexEntry Tracker new 

checkForPendingRequestsForObject: indexedObject 
contentionSpaceProcess: aContentionSpaceProcess 
contentionlndex: contentionlndex.! 



JEstablishMultipleLinksToIndexEntriesWithCleanupJob methodsFor: 'accessing'! 
indexedObject: anObject 

indexedObject := anObject.! 



!EstablishMultipleLinksToIndcxEntricsWithCleanupJob methodsFor: 'initialize-release'! 
initialize 

sit. 

super initialize. 

subscripts := OoVArray new. 

indexEntries :« OoVArray new. 

tempIndexEntriesToDelete := OoVArray new.! 
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Smalltalk defineClass: #IndexEntryAddJob 
superclass: #{OneStepJob} 
indexedType: #none 
private: false 
inslanceVariableNames: ' 

indexEntry <IndexEntry> 

subscript <uint32> 

replyQuorumDenominator <uint32> 

replyTag <uint64> 

replyContentionlndex <uintl6> 

actualNewData <ooTransient> ' 
classInstanceVariableNames: " 
imports: " 

category: 'ENVY/Manager'! 

UndexEntryAddJob class methodsFor: 'private: generated'! 
ooCodeGenVersion 

A l! 

ooTyped Instance VariablesString 

A » 

indexEntry <IndexEntry> 
subscript <uint32> 
replyQuorumDenominator <uint32> 
replyTag <uint64> 
replyContentionlndex <uintl6> 
actualNewData <ooTransient> '! 



UndexEntryAddJob methodsFor: 'accessing'! 
actualNewData 

"Normally this gets transmitted via socket to avoid having to do a remote MROW read." 

actualNewData isNil ifTrue: [ 

actualNewData := indexEntry copy]. 
A actua1NewData! 

t 



UndexEntryAddJob methodsFor: 'checking'! 

checkContentionSpace 

"Make sure I'll only access objects in my own contention space. This check can be 

made at any time after the job has been fully initialized, including just prior to execution." 

[actualNewData contention Index = contentionlndex] assert.! 



! IndexEntry Add Job methodsFor: 'execution'! 
execute With: aContentionSpaceProcess 

| newIndexEntry linkJob | 
newIndexEntry := self actualNewData. 
(newIndexEntry targetContainerln: aContentionSpaceProcess session) ooCluster: newIndexEntry. 
linkJob := EstablishLinkTolndcxEntryWithCleanupJob new 

indexedObject: newlndex&itry indexedObject; 

subscript: subscript; ^. 

indexEntry: newIndexEntry; 

tempIndexEntryToDelete: indexEntry. 
linkJob 

taglnteger: replyTag; 

contentionlndex: replyContentionlndex; 

quorumFraction: 1/ replyQuorumDenominator. 
aContentionSpaceProcess addJob: linkJob. 
observers do: [:each | each index: self hasAdded: indexEntry)"! 

i 
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! IndexEntry AddJob methodsFor: 'accessing'! 
indexEntry: anlndexEntry 



indexEntry :- anlndexEntry. 

contentionlndex :- anlndexEntry contentionlndex. 

actualNewData := anlndexEntry copy.! 



!IndexEntryAddJob methodsFor: 'copying'! 
postCopy 

super postCopy. 
self actualNewData.! 



! Index EntryAddJob methodsFor: 'passivation/activation*! 
preSavePassivation 

"Answer an object to passivate in place of myself. Subclasses should reimplement 
if there is a need to translate the object in some way during passivation." 

self actualNewData. "Make sure this transient instVar has a valid value prior to marshalling." 
A self! 



! IndexEntry Add Job methodsFor: 'accessing'! 
replyContentionlndex: anlnteger 

replyContentionlndex :- anlnteger.! 
replyQuorumDenominator: aDenominatorlnteger 

replyQuorumDenominator := aDenominatorlnteger.! 
replyTag: replyTaglnt 

replyTag :- replyTaglnt.! 
subscript: sub 

subscript := sub.! 

t 



Smalltalk 

superclass: #{OneStepJob} 
indexedType: #none 
private: false 
instanceVariableNames: ' 

indexedObject <Object> 

indexEntry <IndexEntry> 

replyTag <uint64> 

replyQuorumDenominator <uint32> 

objectContentionlndex <uintl6>' 
class InstanceVariableNames: " 
imports: " 
category: "! 

!IndexEntryDeleteJob class methodsFor: "private: generated'! 
ooCodeGenVersion 

A 1! 

ooTyped Instance VariablesString 

A ' 

indexedObject <Object> 
indexEntry <IndexEntry> 
replyTag <uint64> 
replyQuorumDenominator <uint32> 
objectContentionlndex <uintl6>'! 

i 
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UndexEntryDeleteJob methodsFor: 'checking'! 

checkContentionSpace 

"Make sure I'll only access objects in my own contention space. This check can be 
made at any time after the job has been fully initialized, including just prior to execution." 

[indexEntry contentionlndex = contention Index] assert. ! 



UndexEntryDeleteJob methodsFor: 'execution'! 

executeWith: aContention Space Process 

"Delete the index entry and send back a IndexEntry HasBeenDeletedJob with a quorum fraction of 
I / numberOflndexEn tries. This will synchronize with all the other DeleteUnindexedObjectJobs 
sent back by my siblings, the other DeletelndexEntryThenObjectJobs spawned by the original 
DeleteObjectlob." 

| replyJob | 

[indexEntry indexedObject = indexedObject] assert." 
indexEntry ooDelete. 

"Set up a reply job to indicate that the index entry was deleted." 
replyJob := IndexEntryHasBeenDeletedJob new 

indexedObject: indexedObject; 

contentionlndex: objectContentionlndex; 

taglnteger: replyTag; 

quorumFraction: 1 / replyQuorumDenominator. 
aContentionSpaceProcess addJob: replyJob.! 



UndexEntryDeleteJob methodsFor: 'accessing'! 
indexedObject: thelndexedObject 

indexedObject := thelndexedObject.! 
indexEntry: thelndexEntry 

indexEntry := thelndexEntry.! 
objectContentionlndex: theObjectContentionlndex 

objectContentionlndex := theObjectContentionlndex.! 
replyQuorumDenominator: quorum 

replyQuorumDenominator := quorum.! 
replyTag: replyTaglnt 

replyTag := replyTaglnt.! 



Smaiitaik defineCh 

superclass: #{OneStepJob} 
indexedType: #none 
private: false 
instanceVariableNames: ' 

indexedObject <Object> ' 
classInstanceVariableNames: " 
imports:" 

category: 'EWY/ManagertJJ: 

! IndexEntry ReplyJob class methodsFor: 'private: generated'! 
ooCodeGenVersion 

A 1! 

ooTyped Instance VariablesString 

A » 

indexedObject <Object> '! 

i 
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JlndexEntryReplyJob methodsFor: 'private: helpers'! 

addSideEfiectsTo: aMultipleLinkJob 

"Record any side-effects that I produce into a job designed specifically to update multiple pointers to 
index entries and then to check for pending requests on the indexedObject." 

self subclass Responsibility.! 



UndexEntryReplyJob methodsFor: 'execution'! 
collapseJobs: jobs 

"Given a collection of jobs which includes me, answer either nil or a new 
single job that has the same effect as the given jobs. Each job in the 
xollection will be given the chance to collapse, and the first job that replies 
with a collapsed job will be the one that determines how to collapse them. 
Since the jobs are persistent, this is always called within a transaction." 

"I expect to be grouped with other EstablishLinkToIndexEntryWithCleanupJobs. 
Take the IndexEntries present in these jobs and plug them into the object's list 
of known IndexEntries." 

| newJob j 

jobs assertAHType: IndexEntry Reply Job. 

newJob := EstablishMultipleLinksTolndexEntriesWithCleanupJob new. 
newJob indexedObject: indexedObject. 
newJob contentionlndex: contentionlndex. 
jobs do: [:j | 

j addSideEffectsTo: newJob]. 
A newJob! 

executeWith: aContentionSpaceProcess 

self error: 'This should have been collapsed', "(with others like me and/or EstablishLinkToIndexEntryWithCleanupJobs)" 



! IndexEntry ReplyJob methodsFor: 'accessors'! 
indexedObject: anObject 

indexedObject := anObject.! 



UndexEntryReplyJob methodsFor: 'execution'! 
start 

self error: 'This job should have been collapsed.'.! 



Smalltalk defined 

superclass: #{ IndexEntry Reply Job } 
indexedType: #none 
private: false 
instanceVariableNames: 1 

subscript <uint32> 

IndexEntry <IndexEntry^. 

terrrpIndexEntryToDefijte <IndexEntry> ' 
classInstanceVariableNanwih- _ 
imports:" V' 
category: 'ENVY/Manager*! 

!EstablishLinkToIndexEntryWithCleanupJob class methodsFor: 'private: generated'! 
ooCodeGenVersion 

A 1! 

ooTyped Instance VariablesString 

A ■ 

subscript <uint32> 
indexEntry <IndexEntry> 
tempIndexEntryToDelete <IndexEntry> '! 

i 
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!EstablishLinkTolndexEntry WithCleanupJob methodsFor: 'private: helpers'! 

addSideEffectsTo: aMultipleLinkJob 

"Record any side-effects that I produce into a job designed specifically to update multiple pointers to 
index entries and then to check for pending requests on the indexedObject." 

aMultipleLinkJob assertType: EstablishMultipleLinksToIndexEntriesWithCleanupJob. 
aMultipleLinkJob 

addSubscript: subscript 

newIndexEntry: indexEntry. 
aMultipleLinkJob 

add Index En try To Delete: tempIndexEntry To Delete.! 



!EstablishLinkToIndexEntryWithCleanupJob methodsFor: 'accessors'! 
indexEntry: anlndexEntry 

indexEntry := anlndexEntry.! 
subscript: sub 

subscript :- sub.! 
tempIndexEntry ToDelete: tempIndexEntry 

tempIndexEntryToDelete := tempIndexEntry.! 



Smalltalk defineClass: #IndexEntryHasBeenDeletedJob 

superclass: #{ IndexEntry ReplyJob} 
indexedType: #none 
private: false 

instanceVariableNames: " 
classInstanceVariableNames: " 
imports: M 
category: "! 



JlndexEntryHasBeenDeletedJob methodsFor: 'private: helpers'! 

addSideEffectsTo: aMultipleLinkJob 

"Record any side-effects that I produce into a job designed specifically to update multiple pointers to 
index entries and then to check for pending requests on the indexedObject." 

aMultipleLinkJob assertType: EstablishMultipleLinksToIndexEntriesWithCleanupJob. 

"Do nothing. This job simply acts as synchronization."! 

i 



Siralltai^ 

superclass: #{ IndexEntry ReplyJob} 
indexedType: #none 
private: false 
instanceVariableNames: ' 

tempIndexEntryToDelete <IndexEntry>' 
classInstanceVariableNames: " 
imports: " 
category: "! 

!IndexEntryHasBeenUpdate<Uob class methodsFor: 'private: generated'! 
ooCodeGen Version 

A l! 

ooTypedlnstanceVariablesString 

A t 

tempIndexEntryToDelete <IndexEntry>'! 

! 
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! Index Entry HasBeen Updated Job methodsFor: 'private: helpers'! 

addSideEffectsTo: aMultipleLinkJob 

"Record any side-effects that I produce into a job designed specifically to update multiple pointers to 
index entries and then to check for pending requests on the indexedObject." 

aMultipleLinkJob assertType: EstablishMultipleLinksToIndexEntriesWithCleanupJob. 

aMultipleLinkJob addlndexEntryToDelete: temp Index En try ToDelete.! 



UndexEntryHasBeenUpdatedJob methodsFor: 'accessors'! 
tempIndexEntry ToDelete: anlndexEntry 

temp Index En tryToDelete := anlndexEntry.! 



sWiitaik^ 

superclass: #{OneStepJob} 
indexedType: #none 
private: false 
instance VariableNames: * 

indexEntryToUpdate <IndexEntry> 

newIndexEntryData <IndexEntry> 

replyTag <uint64> 

replyQuorumDenominator <uint32> 

replyContentionlndex <uint!6> 

actualNewData <ooTransient> ' 
classlnstance VariableNames: " 
imports: " 

category: 'ENVY/Manager'! 

! Index En tryUpdateJob class methodsFor: 'private: generated'! 
ooCodeGen Version 

A l! 

ooTyped Instance VariablesString 

A • 

indexEntryToUpdate <IndexEntry> 
newIndexEntryData <IndexEntry> 
replyTag <uint64> 
replyQuorumDenominator <uint32> 
replyContentionlndex <uintl6> 
actualNewData <ooTransient> '! 

! 



!IndexEntryUpdateJob methodsFor: 'accessing*! 
actualNewData 

"Normally this gets transmitted via socket to avoid having to do a remote MROW read." 

actualNewData isNil ifTrue: [ 

actualNewData := newIndexEntryData copy]. 
A actualNewData! 

» 



UndexEntryUpdateJob methodsFor: •checking*! 
checkContentionSpace 

"Make sure I'll only access objects in my own contention space. This check can be 

made at any time after the job has been fully initialized, including just prior to execution." 

[((OoDB of: indexEntryToUpdate ooContainer) systemName readStream upTo: $-; upToEnd) trimBIanks aslnteger= contentionlndex] assert. 
[actualNewData contentionlndex = contentionlndex] assert.! 

i 
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! Index Entry UpdateJob methodsFor: 'execution'! 

execute With: aContentionSpaceProcess 

"Update the index entry, then send a job back to the original object (at replyContentionlndex) to 
delete the temporary index entry that we used as the source of our data for this update." 

| replyJob | 

indexEntryToUpdate assignFrom: self actualNewData. 
replyJob := IndexEntryHasBeenUpdatedJob new 

contention Index: replyContentionlndex; 

indexedObject: indexEntryToUpdate indexedObject; 

tempIndexEntryToDelete: newIndexEntryData; 

taglnteger: replyTag; 

quorumFraction: 1 / replyQuorumDenominator. 
aContentionSpaceProcess addJob: replyJob.! 



! I ndexEntry Update Job methodsFor: 'accessing'! 
indexEntryToUpdate: anlndexEntry 

indexEntryToUpdate := anlndexEntry.! 
newIndexEntryData: anlndexEntry 

newIndexEntryData := anlndexEntry. 
actualNewData := anlndexEntry copy.! 



! Index Entry Update Job methodsFor: 'copying'! 
postCopy 

super postCopy. 
self actualNewData.! 

i 



HndexEntryUpdateJob methodsFor: 'passivation/activation'! 
preSavePassivation 

"Answer an object to passivate in place of myself. Subclasses should reimplement 
if there is a need to translate the object in some way during passivation." 

self actualNewData. "Make sure this transient instVar has a valid value prior to marshalling." 
A selfl 



UndexEntry UpdateJob methodsFor: 'accessing'! 
replyContentionlndex: anlnteger 

replyContentionlndex := anlnteger.! 
replyQuorumDenominator: anlnteger 

replyQuorumDenominator := anlnteger.! 
replyTag: anlnteger 

replyTag := anlnteger.! 



Smalltalk defmeClass 

superclass: #{OneStepJob} 
indexedType: #none 
private: false 
instanceVariableNames: ' 

productSubscript <uint32> ' 
classInstanceVariableNames: " 
imports: " 
category: "! 
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IRandomChangeForSaturationTesUob class mcthodsFor: 'private: generated'! 
ooCodeGen Version 

A 1! 

ooTyped Instance VariablesString 

A I 

productSubscript <uint32> '! 



IRandomChangeForSaturationTesUob methodsFor: 'execution'! 
executeWith: aContentionSpaceProcess 

"Make a random change to the product object 1 specify, causing the object to be reindexed if necessary." 

| rootObject | 

rootObject := CreateFakeObjectsJob pickProductUsing: productSubscript contentionSpaceProcess: aContentionSpaceProcess. 
rootObject isStable 
ifTrue: [ 

| oldTransients | 

oldTransients := rootObject transientlndexEntries. 
self makeRandomChangeTo: rootObject. 
IndexEntryTracker new 

contentionSpaceProcess: aContentionSpaceProcess 

object: rootObject 

objectContentionlndex: contention Index 
oldTransientsIfKnown: oldTransients] 

ifFalse: [ 

rootObject isDeleting ifTrue: [ A self]. "Ignore changes to doomed objects." 
[rootObject isReindexing] assert, "not stable means either deleting or reindexing." 
"The reindexing will happen after the current reindexing completes." 
self makeRandomChangeTo: rootObject. 
rootObject requestReindexing].! 

i 



!RandomChangeForSaturationTesUob methodsFor: •private 1 ! 
makeRandomChangeTo: aPerson 

"Make a random change to the product object I specify. Don't trigger reindexing from here. 
The change should have the following distribution: 

1 new call record 

1/15,000 change address 

1/150,000 change name 

1/2,000 change plan 

1/10,000 change line 

1/300 make payment. 
To accomodate those relative frequencies, the relative proportions are mapped onto ranges 
of values in the range 0..1 . The total of these ratio values is: 

1.0d+(l/15000)+(1^50000Hl / 2000>+(l/10000)+(l/300) = 1 .0040066666667d 
Whoops - running short on time now. Ill simplify the test and make *every* change be 
a call record." 



| callRecord | 

callRecord := Telecom_OutboundCallRecord new. "make all records outbound to simplify" 
callRecord 

start: Timestamp now^^ 

duration: 120; r §WI-~ 

calledLine: 21255512l||k 
aPerson accounts first lmerpft&idCall: callRecord.! 



!RandomChangeForSaturationTesUob. methodsFor: 'accessing'! 
productSubscript: anlnteger 

"Set my subscript. This simply indexes into the contention space's RAM cache of all products. 

This whole class is only to be used for computing saturation throughput of the USP." 

productSubscript := anlnteger.! 
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Smalltalk defineClass: #RecacheProductsJob 

superclass: #{OneStepJob} 
indexedType: #none 
private: false 

instanceVariableNames: " 
class Instance VariableNames: " 
imports: " 
category: "! 



IRecacheProductsJob methodsFor: 'execution'! 
executeWith: aContentionSpaceProcess 

"Regenerate the cached collection of all persistent products in this contention space." 

CreateFakeObjectsJob recacheRootObjectsFor: aContentionSpaceProcess. ! 



Smalitaik defineClass: #ComputedAttribute 
superclass: #{SchemaAttribute \ 
indexedType: #none 
private: false 
instanceVariableNames: ' 

computationPolicy <ooShortRef(ComputationPolicy)> 

formula <Formula>' 
class InstanceVariableNames: " 
imports: " 

category: 'ENVY/Manager'! 

IComputedAttribute class methodsFor: 'loading'! 
decode AsLiteral Array: an Array withSchema: schema 

"Return an instance based on the information encoded in anArray and the given schema." 

| attribute | 
attribute := super 

decode AsLiteral Array: (anArray copyFrom: 1 to: anArray size - 2) 

withSchema: schema, 
attribute formula: (anArray at: anArray size - 1) decodeAsLiteralArray. 
attribute computationPolicy: (anArray at: anArray size) decodeAsLiteralArray. 
attribute! 



!ComputedAttribute class methodsFor: 'private: generated'! 
ooCodeGen Version 

A 1! 

ooTypedlnstanceVariablesString 

A • 

computationPolicy <ooShortRefi(ComputationPolicy)> 
formula <Formula>'! 



iComputed Attribute methodsFor: 'accessing'! 
computationPolicy 

A computationPolicy! -r. 
computationPolicy: aComputatidsjpolicy 

aComputationPolicy assertType: ComputationPolicy. 
computationPolicy :- aComputationPolicy.! 
formula 

A formula! 
formula: aFormula 

aFormula assertType: Formula, 
formula := aFormula.! 

! 
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! Computed Attribute methodsFor: 'testing'! 
isComputed 



A true! 



! Computed Attribute methodsFor: 'dumping'! 
literal Array Encoding 

"Convert me to a literal array." 

A super literal Array Encoding, 
(Array 

with: self formula literal Array Encoding 

with: self computationPolicy literalArray Encoding)! 



Smalltalk defineClass: #Uncomputed Attribute 

superclass: #{SchernaAttribute} 
indexedType: #none 
private: false 

instance VariableNames: " 
classInstanceVariableNames: " 
imports: " 

category: 'ENVY/Manager 1 ! 

lUncomputedAttribute methodsFor: 'testing'! 
isComputed 

A false! 



Smalltalk defineClass: #IndexedSchemaClass 
superclass: #{SchemaClass} 
indexedType: #none 
private: false 
instance VariableNames: ' 

indices <OoVArray(Index)>' 
classInstanceVariableNames: " 
imports: " 

category: 'ENVY/ManagerM 



SIndexedSchemaClass class methodsFor: 'private: generated'! 
ooCodeGen Version 

M! 

ooTypedlnstanceVariablesString 



A t 



indices <OoVArray(Index)>'! 
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! Indexed SchemaClass methodsFor: 'accessing'! 
allUniquelndices 

"Answer a collection containing indices with unique keys for myself and my superclasses 
and my subclasses." 

| uniques | 

uniques := OrderedCollection new. 
superclass notNil ifTrue: [ 

uniques addAll: superclass applicableUniquelndices]. 
uniques addAll: self uniquelndices. 
self allSubclasses do: [:sub | 

uniques addAll: sub uniquelndices]. 
A uniques asArray! 
applicableUniquelndices 

"Answer a collection containing indices for myself and my superclasses that must have unique keys. 
Don't look at my subclasses." 

| myUnique | 

myUnique := self uniquelndices. 
superclass notNil 

ifTrue: [ A superClass applicableUniquelndices, myUnique] 

ifFalse: [ A myUnique].! 

indices 

A indices! 
indices: somelndices 

somelndices do: [:ind | ind assertType: Index], 
indices = somelndices ifTrue: [ A self]. 
indices replaceWithElements: somelndices. 

self ooUpdate. "Compensate for Objectivity bug with empty OoV Arrays."! 



! Indexed SchemaClass methodsFor: 'initialize-release'! 
initialize 

super initialize. 

indices := OoV Array new. 

A selfl 



HndexedSchemaClass methodsFor: 'maintenance'! 
replace Attribute: old Attribute with: newAttribute 

"Replace the old attribute with a new one. For every reference from the schema's subobjects to 

the old attribute, update it to refer to the new attribute." 

super replace Attribute: oldAttribute with: newAttribute. 

indices do: [:role | role replaceAttribute: oldAttribute with: newAttribute].! 



!IndexedSchemaClass methodsFor: 'accessing'! 
uniquelndices 

"Answer a collection containing just my indices that must have unique keys. Don't look at 
my superclasses and subclasses." 

A indices select: [:tnd | ind isUnique]! 



Smalltalk defmeClass: #Role6bject 
superclass: #{Core.Object} 
indexedType: #none 
private: false 
instance VariableNames: ' 

localObject <ooShortRef(Object)> * 
classInstanceVariableNames: 'cachedlndex ' 
imports: " 

category: 'ENVY/Manager'! 
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IRoleObject class methodsFor: "private: generated'! 
ooCodeGen Version 



A 1! 

ooTypedlnstanceVariablesString 



localObject <ooShortRefi[Object)> '! 

i 



IRoleObject methodsFor: 'accessing'! 
attachTo: anotherRoleObject 

"Tell the other role object to plug me in as its neighbour." 

anotherRoleObject assertType: RoleObject. 
self subclassResponsibility.! 
connectedRoles 

"Answer a collection of currently connected neighbouring roles (exclude myself, of course). 
Include nils as placeholders for roles that have not been connected yet." 

self subclassResponsibility.! 
isFullyConnectedToOtherRoles 

A (self connectedRoles includes: nil) not! 
localObject 

A localObject! 
localObject: anObject 

localObject := anObject.! 

! 

Smalltalk defineClass: #SchemaLookupStructure 

superclass: #{ Core. Object} 
indexedType: #none 
private: false 
instanceVariableNames: ' 

datapaths <ooVArray(ooShortRefl(AttributePath))> 

keys <ooVArray(ooShortRefi(AttributePath))> * 
classInstanceVariableNames: " 
imports: " 

category: 'ENVY/Manager'! 



!SchemaLookupStructure class methodsFor: 'instance creation'! 
keys: keyAttributePaths dataPaths: dataAttributePaths 

A self new 

keys: keyAttributePaths; 
dataPaths: dataAttributePaths; 
yourself! 

new 

A super new initialize! 

i 



!SchemaLookupStructure class 
ooCodeGenVersion 



A 1! 

ooTypedlnstanceVariablesString 




dataPaths <ooV Array(ooShortRef^AttributePath))> 
keys <ooVArray(ooShortRef(AttributePath))> '! 

! 
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!SchemaLookupStructure methods For: 'accessing'! 
add DataPath: anAttributePath 



anAttributePath aisertType: AttributePath. 
dataPaths add Element: anAttributePath. 

self ooUpdate. "Compensate for Objectivity bug with empty OoVArrays." 
self changed: #dataPaths.! 
addKey: anAttributePath 

anAttributePath assertType: AttributePath. 
keys addElement: anAttributePath.. 

self ooUpdate. "Compensate for Objectivity bug with empty OoVArrays." 
self changed: #keys.! 
attributePathlsLegalKey: anAttributePath 

"Answer whether the given attribute path would make a legal key." 

anAttributePath attributes do: [:attr | 

attr cardinality isMany ifTrue: [ A false]]. 
A an AttributePath attributes last type isPrimitive! 



ISchemaLookupStructure methodsFor: 'maintenance'! 
cleanlipIllegalPathsWithType: aSchemaClass 

self datapaths: (self datapaths select: [:path | 

path isLegalPathForlndex: 1 type: aSchemaClass]). 

self keys: (self keys select: [:path | 

path isLegalPathForlndex: 1 type: aSchemaClass]).! 
clean up Removed Attribute: an Attribute 

"This SchemaAttribute has been removed. Clean up my indices and roles." 

self dataPaths: 

(self dataPaths reject: [:path | 

path attributes includes: anAttribute]). 

self keys: 

(self keys reject: [:path | 

path attributes includes: anAttribute]).! 

! 



!SchemaLookupStructure methodsFor: 'accessing'! 
dataPaths 

MataPaths! 
dataPaths: someAttributePaths 



someAttributePaths assertAHType: AttributePath. 

dataPaths replace WithElements: someAttributePaths. 

self ooUpdate. "Compensate for Objectivity bug with empty OoVArrays." 

self changed: fldataPaths.! 



!SchemaLookupStructure methodsFor: 'initialize-release'! 
initialize 

Hu. 

keys := OoV Array new. a S?-"]X 
dataPaths OoVArray new;f rv T 



!SchemaLookupStructure methodsFor: 'accessing'! 
isUnique 

A false! . 

keys 

A keys! 
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keys: some Attribute Paths 



someAttributePaths assertAllType: Attribute Path, 
keys replaceWithElements: someAttributePaths. 

self ooUpdate. "Compensate for Objectivity bug with empty OoVArrays. ,, 
self changed: #keys.! 
numberOfContainers 



ISchemaLookupStructure methodsFor: 'copying'! 
postCopy 

| mapping | 
super postCopy. 

mapping := Identity Dictionary new. 
dataPaths := dataPaths collect: [:path | 

mapping at: path ifAbsentPut: [path copy]], 
keys := keys collect: [:path | 

mapping at: path ifAbsentPut: [path copy]]. 



ISchemaLookupStructure methodsFor: 'accessing'! 
removeDataPath: anAttributePath 

"Note that equality is used to locate the actual AttributePath to remove." 

anAttributePath assertType: AttributePath. 
dataPaths removeElementBy Equality: anAttributePath. 
self ooUpdate. "Compensate for Objectivity bug with empty OoVArrays." 
self changed: #dataPaths.! 
removeKey: anAttributePath 

"Note that equality is used to locate the actual AttributePath to remove." 

anAttributePath assertType: AttributePath. 

keys removeElementBy Equality: anAttributePath. 

self ooUpdate. "Compensate for Objectivity bug with empty OoVArrays." 

self changed: #keys.! 

i 



ISchemaLookupStructure methodsFor: 'maintenance'! 
replace Attribute: oldAttribute with: new Attribute 

"Replace the old attribute with a new one. For every reference from the schema's subobjects 
the old attribute, update it to refer to the new attribute." 

dataPaths do: [:path | 

path replace Attribute: oldAttribute with: newAttribute]. 
keys do: [:path | 

path replace Attribute: oldAttribute with: newAttribute].! 

! • ■ 

Smalltalk defineClass: #lndex 

superclass: #{SchemaLookupStructure} 
indexedType: #none 
private: false 
instance VariableNames: * 
name <OoVString> 
isUnique <boolean> 

observers <OoVArray(IndexObserver)> ' 
classlnstance VariableNames: M 
imports: " 

category: 'ENVY/Manager'! 
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! Index class methodsFor: 'loading'! 

decodeAsLiteralArray: anArray withSchema: schema forClass: els 

"Return an instance based on the information encoded in anArray and the 
given Schema and SchemaClass." 

| nameString indexObservers dataPaths keyPaths instance isUnique | 
[anArray size - 6] assert. 
nameString :- (anArray at: 2). 
isUnique := (anArray at: 3). 

indexObservers := (anArray at: 4) collect: [:arr | arr decodeAsLiteralArray]. 
dataPaths :- (anArray at: 5) collect: [:arr | 

j attrs currentType | 

currentType :- els. 

attrs OrderedCollection new: arr size, 
arr do: [:attrName | 

attrs addLast: (currentType all Attributes detect: [:x | x name = attrName]). 

currentType := attrs last type]. 
AttributePath new attributes: attrs]. 
keyPaths :- (anArray at: 6) collect: [:arr | 
| attrs currentType | 
currentType := els. 

attrs := OrderedCollection new: arr size. 

arr do: [:attrName | 

attrs addLast: (currentType all Attributes detect: [:x | x name = attrName]). 
currentType := attrs last type]. 

AttributePath new attributes: attrs]. 
instance := self 

name: nameString 

observers: indexObservers 

keys: keyPaths 

dataPaths: dataPaths. 
instance isUnique: isUnique. 
^instance! 



! Index class methodsFor: 'instance creation'! 
fromlndex: an Index 

"Answer a new instance of me that looks like anlndex. Feel free to reuse pieces of 
anlndex, as it will not be used after this call." 

A self 

name: anlndex name 
observers: anlndex observers 
keys: anlndex keys 
dataPaths: anlndex datapaths! 



! Index class methodsFor: 'class accessing'! 
mechanisms 

"This should be rewritten some day to be more pluggable." 

dictionary new 

at: 'One Container' put Containerlndex; 
at: 'Parallel Index' put^aralleUndex; 




! Index class methodsFor: 'instance creation'! 

name: aString observers: indexObservers keys: keyAttributePaths dataPaths: dataAttributePaths 

A (self keys: keyAttributePaths dataPaths: dataAttributePaths) 
name: aString; 
observers: indexObservers; 
yourself! 
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! Index class methodsFor: 'private: generated'! 
ooCodeGen Version 

A t! 

ooTypedlnstanceVariablesString 



name <OoVString> 
isUnique <boolean> 

observers <OoVArray(IndexObserver)> '! 



! Index methodsFor: 'accessing*! 
addObserver: anObserver 

anObserver assertType: IndexObserver. 
observers add Element: anObserver. 

self ooUpdate. "Compensate for Objectivity bug with empty OoV Arrays." 
self changed: #observers ! 
at: subscript putContainer: aContainer contention Index: contentionlndex 



self subclass Responsibility.! 

i 



!Index methodsFor: 'accessing-ui'! 
attributePathlsLegalContentionKey: anAttributePath 

"Answer whether the given attribute path would make a legal contention key." 

anAttributePath attributes do: [:attr | 

attr cardinality isMany ifTrue: [ A false]. 

attr type hasldentity ifTrue: [ A false]]. 
A anAttributePath attributes last type isPrimitive! 
attributePathlsLegalKey: anAttributePath 

"Answer whether the given attribute path would make a legal key." 

"Although plain lookup structures can't use attributes with cardinality many in the 
chain of attributes for a key, an Index can. That's because many IndexEntries 
may be created to index one object, whereas the lookup structures might not be 
able to fan out that way." 

"anAttributePath attributes last type isPrimitive! 

t 



! Index methodsFor: 'accessing'! 
containerFor: anlndexEntry inSession: session 

"Answer the OoContainer in which one would find anlndexEntry." 

self subclassResponsibility.! 
contentionSpaceFor: anlndexEntry 

"Answer which contention space should contain anlndexEntry." 

self subclassResponsibility.! 

H 

! Index methodsFor: 'printing'! '^f^" 
displayString 

darnel 



! Index methodsFor: 'initialize-release'! 
initialize 



super initialize, 
name := String new. 
observers := OoV Array new. 
isUnique ~ true.! 
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! Index methodsFor: 'accessing'! 
isUnique 

A isUnique! 
isUnique: aBootean 

isUnique := aBoolean.! 



Ilndex methodsFor: 'dumping'! 
literal Array Encoding 

"Convert me to a literal array." 

A (Array new: 6) 

at: 1 put: self class fullyQualified Reference; 
at: 2 put: self name; 
at: 3 put: self isUnique; 

at: 4 put: (observers asArray collect: [:ob | ob literalArrayEncoding]); 
at: 5 put: (self datapaths asArray collect: [:path | 

path attributes collect: [:attr | attr name]]); 
at: 6 put: (self keys asArray collect: [:path J 

path attributes collect: [:attr | attr name]]); 
yourself! 



Ilndex methodsFor: 'accessing'! 
name 

A name! 
name: aString 

name := aString.! 
observers 

A observers! 
observers: someObservers 

someObservers assertAUType: IndexObserver. 
observers replace WithElements: someObservers. 

self ooUpdate. "Compensate for Objectivity bug with empty OoV Arrays." 
self changed: ^observers.! 

t 



! Index methodsFor: 'copying'! 
postCopy 

super postCopy. 

observers := observers copy.! 

i 
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! Index methodsFor: 'printing'! 

printShortDescriptionOn: aTextStream internal: is Internal stereotypes: stereotypes 

"Write a short description of me to the text stream. Make it suitable for presentation in a user interface." 

| order | 

name isEmpty iflFalse: [ 

aTextStream emphasis: #italic; nextPutAll: name; emphasis: nil. 
stereotypes notEmpty ifTrue: [ 

aTextStream space; nextPut: (Character value: 171 ). "open chevron" 
stereotypes 

do: [:str | aTextStream nextPutAll: str] 
separatedBy: [aTextStream nextPutAll: ']. 
aTextStream nextPut: (Character value: 187)]]. "close chevron" 
[self keys all: [:key | self datapaths includes: key]] assert: 'Inconsistent index definition', 
order := self keys asSortedCollection asArray, 

(self dataPaths asSet - self keys asSet) asSortedCollection asArray. 

order 

do: [.sourcePath | 
aTextStream cr. 

is Internal ifTrue: [aTextStream tab], 
(self keys includes: sourcePath) 

ifTrue: [aTextStream emphasis: #bold] 
iflFalse: [aTextStream emphasis: nil]. 
sourcePath attributes 

do: [:subAttr | aTextStream nextPutAll: subAttr name] 
separatedBy: [aTextStream nextPutAll: '-']] 
separatedBy: [aTextStream nextPutAll: ',']. 
aTextStream emphasis: nil.! 



! Index methodsFor: 'accessing'! 
removeObserver: anObserver 

anObserver assertType: IndexObserver. 
observers removeElement: anObserver. 

self oollpdate. "Compensate for Objectivity bug with empty OoV Arrays." 
self changed: #observers.! 



! Index methodsFor: 'initialize-release'! 

setName: aString observers: indexObservers keys: keyAttributePaths instanceVariableSources: ivarAttribute Paths 
name := aString. 

observers := indexObservers asOoV Array, 
keys := keyAttributePaths asOoV Array. 
dataPaths := ivarAttributePaths asOoV Array. 
A self1 



Smalltalk defineClass: #Containerindex 

superclass: #{ Index} 

indexedType: #none 

private: false 

instance VariableNames: * 

contentionlndex <uintS&r 
targetContainerNuTnb^tcuin^^ 

c lass Instance VariableNames: ' 

imports: " 

category: 'ENVY/ManagerM 



!Containerlndex class methodsFor. 'private: generated 1 ! 
ooCodeGenVersion 

A 1! 

ooTyped Instance VariablesString 

A « 

contentionlndex <uint32> 
targetContainerNumber <uint32>'! 

i 
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!Containerlndex methodsFor: 'accessing'! 

at: subscript putContainerNumber: aContainerNumber contentionlndex: newContentionlndex 



[subscript = 1 ] assert. 

[targetContainerNumber = 0] assert. 
targetContainerNumber := aContainerNumber. 

[contentionlndex = 0] assert, "uninitialized" 
[newContentionlndex > 0] assert, "l.-max" 
contentionlndex := newContentionlndex.! 
containerFor: anlndexEntry inSession: session 

"Answer the OoContainer in which one would find anlndexEntry. Called in a transaction of session.' 

anlndexEntry assertType: Index Entry. 

A session ooProvideContainerFor: targetContainerNumber with: 'ignored'! 
contentionSpaceFor: anlndexEntry 

"Answer which contention space should contain anlndexEntry." 

A contentionIndex! 



!ContainerIndex methodsFor: 'private: instance creation'! 
initialize 

super initialize. 

contentionlndex := 0. "invalid, indicating containers have not been assigned yet."! 

i 



!Containerlndex methodsFor: 'accessing'! 
numberOfContainers 



Smalltalk defineClass: #ParaiielIndex 
superclass: #{ Index} 
indexedType: #none 
private: false 
instance VariableNames: ,' 

contentionlndexes <ooVArray(uint32)> 

numberOfContainers <uint32> 

targetContainerNumbers <ooVArray(uint32)> ' 
classlnstance VariableNames: " 
imports: " 

category: 'ENVY/Manager'! 

{Parallel Index class methodsFor: 'loading'! 
decodeAsLiteralArray: anArray withSchema: schema forClass; els 

"Return an instance based on the information encoded in anArray and the 

given Schema and SchemaClass." 

I index | 

index := super : 

decodeAsLiteralAn«^(^AnBy copyFrom: I to: anArray size - 1) 

withSchema: schemaf^?^ 

forClass: els. 
index numberOfContainers: anArray last. 
A index! 
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! Parallel Index class methodsFor: 'instance creation'! 
defaultNumberOfContainers 



A 5! 

fromlndex: anlndex 

"Answer a new instance of me that looks like anlndex. Feel free to reuse pieces of 
anlndex, as it will not be used after this call." 

(anlndex isKindOf: Parallel Index) ifTrue: [ A anlndex]. 
A self 

name: anlndex name 
observers: anlndex observers 
keys: anlndex keys 
dataPaths: anlndex datapaths! 

name: aString observers: indexObservers keys: key Attribute Paths datapaths: dataAttribute Paths numberOfContainers: anlnteger 
. A (super 

name: aString 

observers: indexObservers 

keys: keyAttributePaths 

dataPaths: dataAttributePaths) 
numberOfContainers: anlnteger; 
yourself! 



IParallellndex class methodsFor: 'private: generated'! 
ooCodeGenVersion 

A 1! 

ooTypedlnstanceVariablesString 

A • 

contentionlndexes <ooVArray(uint32)> 
numberOfContainers <uint32> 
targetContainerNumbers <ooVArray(uinG2)> '! 



IParallellndex methodsFor: 'accessing'! 

at: subscript putContainerNumber: aContainerNumber contention Index: contention Index 

[subscript between: 1 and: numberOfContainers] assert. 
targetContainerNumbers size = 0 ifTrue: [ 
[contentionlndexes size = 0] assert. 

targetContainerNumbers replace WithElements: (Array new: numberOfContainers withAll: 0). 
contentionlndexes replaceWithElements: (Array new: numberOfContainers withAll: 0). 
self ooUpdate]. 

[(targetContainerNumbers at: subscript) = 0] assert. 
targetContainerNumbers at: subscript put: aContainerNumber. 

[(contentionlndexes at: subscript) = 0] assert, 
[contentionlndex > 0] assert. "L.max" 
contentionlndexes at: subscript put: contentionlndex! 
containerFor: anlndexEntry inSession: session 

"Answer the OoContamer ii^wmch one would find anlndexEntry. Called in a transaction of session." 

• 

| containerNum | -~ 
anlndexEntry assertType: fiidexEntry. 

containerNum := targetContainerNumbers at: anlndexEntry hashOfKey - 1 \\ numberOfContainers + I . 
A session 

ooProvideContainerFor: containerNum 
with: 'ignored'! 
containersHaveBeenCreated 

A targetContainerNumbers size = numberOfContainers! 
contentionSpaceFor: anlndexEntry 

"Answer which contention space should contain anlndexEntry." 

anlndexEntry assertType: IndexEntry. 

Contentionlndexes at: anlndexEntry hashOfKey - 1 \\ numberOfContainers + 1 ! 

i 



86 



'.Parallel Index methodsFor: 'initialize-release'! 
initialize 

super initialize. 

targetContainerNumbers := OoV Array new. 
contention Indexes := OoV Array new. 

numberOfContainers :- self class defaultNumberOfContainers.l 



IParallellndex methodsFor: 'dumping'! 
literal Array Encoding 

"Convert me to a literal array." 

A super literal Array Encoding copy With: numberOfContainers! 



'.Parallel Index methodsFor: 'accessing'! 
numberOfContainers 

NumberOfContainers! 
numberOfContainers: anlnteger 

[targetContainerNumbers isEmpty] assert: 'Can"t change index dimensions after creation'. 
numberOfContainers := anlnteger.! 

i 



IParallellndex methodsFor: 'copying'! 
postCopy 

super postCopy. 

targetContainerNumbers := targetContainerNumbers copy, 
contention Indexes := contentionlndexes copy.! 

I 

Smalltalk.Applications defineClass: #IndexingFramework 
superclass: #{ ENVY. Application} 
indexedType: #none 
private: false 

instanceVariableNames: " 
classInstanceVariableNames: " 
imports: " 

category: 'ENVY/Manager'! 

! Core: Array methodsFor: 'printing'! 
printCompletelyOn: aStream indent: indent 

"Print all of my elements, not j ust the first few thousand bytes, onto aStream. Indent 

successive subarrays by the given amount as appropriate." 

self size < 20 ifTrue: [ 
| temp multiline | 

temp := Write Stream on: (String new: 100). 

temp nextPut: $(. . 

multiline := (1 to: serf size) any: [:i 1 

(self at: i) print^^letelyOn: temp indent: indent. 

i = self size ifFalsc: [temp space]. 

temp position > 100]. 
multiline ifFalse: [ 

temp nextPut: $). 

aStream nextPutAll: temp contents. 

A self]]. 
aStream nextPut: $(. 
1 to: self size do: [:i | 

aStream crtab: indent. 

(self at: i) printCompletelyOn: aStream indent: indent + 1]. 
aStream nextPut: $).! 

i 
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'.Core.Object methodsFor: 'printing'! 

printCompletelyOn: aStream indent: indent 

"Print me, not just the first few thousand bytes, onto aStream. Indent 
successive subarrays by the given amount as appropriate." 



self printOn: aStream. "Note - arrays embedded within other collections will not work.' 

i 
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! Schema class methodsFor: 'loading'! 
decodeFromLiteral Array: anArray 

"Return an instance based on the information encoded in anArray." 

| schema | 

[anArray size = 8] assert, 
schema := self new. 

schema lastSave: (Timestamp fromMilliseconds: (anArray at: 2) decodeAsLiteralArray). 

"Create the bare classes...*' 
(anArray at: 3) do: [:array | 
Ids | 

els := array decodeAsLiteralArray. 

schema addSchemaClass: els named: els name]. 

"Link up inheritance..." 
(anArray at: 4) do: [:pair | 

| childClass parentClass | 
childClass := pair first. 
parentClass := pair last. 
parentClass notNil ifTrue: [ 

(schema schemaClassNamed: childClass) 

superclass: (schema schemaClassNamed: parentClass)]]. 

"Link up the attributes..." 
(anArray at: 5) do: [:pair | 

| sourceClass array attr | 

sourceClass := pair first. 

array := pair last. 

attr array first asQualifiedReference value 

decodeAsLiteralArray: array 

withSchema: schema, 
(schema schemaClassNamed: sourceClass) addAttribute: attr]. 

"Set up the class indices;.." 
(anArray at: 6) do: [:triple | 
| els kind index | 

els := schema schemaClassNamed: triple first, 
kind := triple at: 2. 
index := triple last. 

index := index first asQualifiedReference value 

decodeAsLiteralArray: index 

withSchema: schema 

forClass: els. 
kind = tfrecordlndex ifTrue: [ 

self error: 'Record indices are no longer supported'], 
[kind = #objectIndex] assert, 
els indices: (els indices copyWith: index)]. 

"Set up the roots..." 
(anArray at: 7) do: [:rootTypeName | 
| rootAttrName attr | 

rootAttrName := rootTypeName asString copy. 

rootAttrName at: 1 put: rootAttrName first as Lowercase. 

attr := SchemaAttribtittfg:. . 

name : rootAttrN&gv asSymbol 

type: (schema sc^^aClassNamed: rootTypeName). 

attr single. 

schema addRoot: attr]. 

"Set up the relationships..." 
(anArray at: 8) do: [:subarray | 
| relationship | 
[subarray size ■ 4] assert, 
relationship := SchemaRelationship 
decodeAsLiteralArray: subarray 
withSchema: schema, 
schema addRelationship: relationship]. 

A schema! 
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! Schema methodsFor: 'dumping'! 
dumpString 

"Convert me into a dumped representation which, when compiled as Smalltalk code, 
produces a Schema like the receiver." 

| str encoding | 

encoding := self literal Array Encoding, 
[encoding size = 8] assert. 

str := WriteStream on: (String new: 1000). 
str nextPutAll: "'Schema definition file'"; cr; cr. 
str nextPutAll: '#('; crtab; print: (encoding at: 1 ). 

str crtab; nextPutAll: '"Last saved:" '. 

str print: (encoding at: 2); nextPutAll: ' "= ', self lastSave printString, ""; cr. 
str crtab; nextPutAll: '"Classes:" f. 

(encoding at: 3) do: [:sub | str crtab: 2. sub printCompletelyOn: str indent: 3]. 
str nextPutAll: ')'; cr. 

str crtab; nextPutAll: '"Class inheritance:" ('. 

(encoding at: 4) do: [:sub | str crtab: 2. sub printCompletelyOn: str indent: 3]. 
str nextPutAll: ')'; cr. 

str crtab; nextPutAll: '"Attributes:" ('. 

(encoding at: 5) do: [:sub | str crtab: 2. sub printCompletelyOn: str indent: 3]. 
str nextPutAll: ')'; cr. 

str crtab; nextPutAll: '"Class Indices:" ('. 

(encoding at: 6) do: [:sub | str crtab: 2. sub printCompletelyOn: str indent: 3]. 
str nextPutAll: 7; cr. 

str crtab; nextPutAll: "'Root classes:" ('. 

(encoding at: 7) do: [:sub | str crtab: 2. sub printCompletelyOn: str indent: 3]. 
str nextPutAll: ')'; cr. 

str crtab; nextPutAll: '"Relationships:" (\ 

(encoding at: 8) do: [:sub | str crtab: 2. sub printCompletelyOn: str indent: 3]. 
str nextPutAll: ')'; cr. 

str nextPutAll: ') decodeAsLiteral Array'; cr. 

A str contents! 
literalArrayEncoding 

"Convert me to a literal array." 

| theClasses theAttributes theClassIndices theRelationships | 

theClasses := schemaClasses asSortedCollection: [:a :b | a name <= b name]. 

theAttributes := OrderedCollection new: 50. 

theClassIndices := OTderedCol lection new: 50. 

theRelationships := schemaRelationships asSortedCollection: [:a :b | a name <= b name]. 
theClasses do: [:cls | 

els attributes do: [:attr | 

theAttributes add: (Array with: els name with: attr literalArrayEncoding)]. 

els indices do: [:ind | 

theClassIndices*^: (Array with: els name with: #objectIndex with: ind literalArrayEncoding)]. 

]■ m 

A (Array new: 8) , 

at: 1 put: self class ruirjS^ualificdReference; 
at: 2 put: self lastSave asMilliseconds; 
at: 3 put: (theClasses asArray collect: [:cls | 

els literalArrayEncoding]); 
at: 4 put: (theClasses as Array collect: [:cls | 

Array with: els name with: (els superclass isNil ifTrue: [nil] ifFalse: [els superclass name])]); 
at: 5 put: theAttributes asArray; 
at: 6 put: theClassIndices asArray; 
at: 7 put: (self rootsCollect: [:r | r type name]) asArray; 
at: 8 put: (theRelationships asArray collect: [:rel 1 

rel literalArrayEncoding]); 
yourself! 
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ICore.UndefinedObject methodsFor: 'objy helper'! 
delete 

"Recursively delete this object from Objectivity. This nil terminates the recursion (as will identity-like attributes). 
A self! 
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Smalltalk defineClass: #Telecom_Account 
superclass: #{ Core .Object} 
indexedType: #none 
private: false 
instanceVariableNames: ' 

accountNumber <uint64> 

billingAddress <ooShortRef(Telecom_Address)> 

billingMethod <ooShortRefl(Telecom_BillmgMethod)> 

lines <ooVArray(Telecom_Line)> 

payments ^oVArrayCooShortRe^Telecom^Payment)^' 
classInstanceVariableNames: " 
imports: " 

category: 'Generated Code - Applications.GeneratedCodeApp'! 



!Telecom_Account class methodsFor: 'Generated - instance creation'! 
new 

Generated method 



A supeT new initializeAccount! 

i 



!Telecom_Account class methodsFor: 'private: generated'! 
ooCodeGen Version 



A 1! 

ooTyped Instance VariablesString 



accountNumber <uint64> 

billingAddress <ooShortRef[Telecom_Address)> 

billingMethod <ooShortRefi(Telecom_BillingMethod)> 

lines <ooVArray(Telecom_Line)> 

payments <ooVArray(ooShortRefi(Telecom_Payment))>'! 



!Telecom_ Account methodsFor: 'Generated - comparing'! 
- other 

"*** Generated method ***" 

other = self ifTrue: [ A true]. 

other ooClass — self ooClass ifFalse: [ A false]. 

self billingAddress = other billingAddress ifFalse: [ A false]. 

self accountNumber = other accountNumber ifFalse: [ A false]. 

self billingMethod = other billingMethod ifFalse: [ A false]. 

self payments = other payments ifFalse: [ A false]. 

self lines = other lines ifFalse: [ A false]. 

A true! 

! 



!Telecom_Account methodsFor: 'Generated - accessing'! 
accountNumber 

"*** Generated method ***" 



accountNumber assertT: 
A accountNumber! 
accountNumber: anlnteger 
M *** Generated method 



anlnteger assertTypeOrNil: Integer. 
accountNumber := anlnteger. 
self changed: #accountNumber.! 
addLine: aLine 

"**• Generated method *** M 

"aLine assertType: Telecom_Line." 

lines addElement: aLine. 

self ooUpdate. 

self changed: #lines.! 
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addPayment: aPayment 

"*** Generated method ***" 

"aPayment assertType: Telecom_Payment." 

payments addElement: aPayment. 

self ooUpdate. 

self changed: #payments.! 



!Telecom_Account methodsFor: 'Generated - assignment'! 
assignFrom: other 

"*** Generated method 

other = self ifTrue: [ A selfj. 

[other ooClass = self ooClass] assert. 

self billingAddress ooClass = other billingAddress ooClass 

ifTrue: [self billingAddress assignFrom: other billingAddress] 
ifFalse: [ 

self billingAddress delete, 
self billingAddress: other billingAddress]. 
self accountNumber: other accountNumber. 
self billingMethod ooClass — other billingMethod ooClass 

ifTrue: [self billingMethod assignFrom: other billingMethod] 
ifFalse: [ 

self billingMethod delete, 
self billingMethod: other billingMethod]. 
self payments = other payments ifFalse: [ 
self payments do: [:x | x delete], 
self payments: other payments], 
self lines: other lines.! 



!Telecom_Account methodsFor: 'Generated - accessing'! 
billingAddress 

"•** Generated method 

billingAddress assertTypeONil: Telecom_Address. 
A bil ling Address! 
billingAddress: anAddress 

"*** Generated method ***" 

anAddress assertTypeONil: Telecom_Address. 
billingAddress := anAddress. 
self changed: #billingAddress.! 
billingMethod 

"**• Generated method 

billingMethod assertTypeOrNil: Telecom_BillingMethod. 
"billingMethod! 
billingMethod: aBillingMethod 
"•** Generated method 

aBillingMethod assertTypeOrNil: Telecom_BillingMethod. 
billingMethod := aBillingMethod. 
self changed: #billingMethod. ! 
clear AccountNumber 

"*** Generated method 

accountNumber := 16rF 
self changed: #accountNumber.! 
clearBillingAddress 

"*** Generated method ***" 

billingAddress delete. 
billingAddress nil. 
self changed: #billingAddress.! 
clearBillingMethod 

"*•* Generated method ***" 

billingMethod delete. 
billingMethod := nil. 
self changed: #billingMethod.! 
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clearLines 

"*** Generated method 

lines do: [:x | x delete], 
lines replaceWithElements: #()• 
self oollpdate. 
self changed: #lines.! 
clearPayments 

Generated method ***" 

payments do: [:x | x delete], 
payments replaceWithElements: #(). 
self ooUpdate. 
self changed: #payments.! 

t 



!Telecom_Account methodsFor: 'Generated - clustering'! 
clusterWith: anObjectToClusterWith 
Generated method 

anObjectToClusterWith mioCluster: self. 
billingAddress clusterWith: self. 
billingMethod clusterWith: self, 
payments do: [:x | x clusterWith: self], 
lines do: [:x | x clusterWith: self).! 

i 



!Telecom_Account methodsFor: 'Generated - deletion'! 
delete 

"*** Generated method ***" 



selfooIsPersistentifFalse: [ A self]. 
billingAddress delete. 
billingMethod delete, 
payments do: [:x | x delete]. 
selfooDelete.! 



!Telecom_Account methodsFor: 'Generated - comparing'! 
hash 

Generated method ***" 

| runningHash | 
runningHash := 0. 

runningHash := (billingAddress goodHash + runningHash) timesRandomMultiplier. 
runningHash := (accountNumber goodHash + runningHash) timesRandomMultiplier. 
runningHash :~ (billingMethod goodHash + runningHash) timesRandomMultiplier. 
runningHash := ((payments sum: [:x | x goodHash]) + runningHash) timesRandomMultiplier. 
runningHash := ((lines sum: [:x | x goodHash]) + runningHash) timesRandomMultiplier. 
A runningHash bitXor: 1 6rO5E7054E! 
. hasSameUniquenessKeysAs: other 
Generated method *** n 

other = self ifTrue: ['"truc]^, 

other ooClass — self ooG^toFalse: [ A false]. 

A true! : |pSt 

!Telecom_Account methodsFor: "Generated - initialization*! 
initializeAccount 

"*** Generated method *** M 

billingAddress := Telecom_Address new. 
accountNumber 1 6rFFFFFFFFFFFFFFFF. 
billingMethod := Telecom_BillingMethod new. 
payments := OoV Array new. 
lines := OoV Array new.! 

i 
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!Telecom_Account methodsFor: 'Generated - accessing'! 
lines 

"*** Generated method ***" 

"lines assertAHType: Telecom_Line." 
A 1ines! 
lines: someLines 

"*** Generated method ***" 

"someLines assertAHType: TelecomJJne." 
lines replaceWithElements: someLines. 
self ooUpdate. 
self changed: #lines.! 
payments 

"*** Generated method ***" 

"payments assertAHType: Telecom_Payment." 
payments! 
payments: somePayments 

"*** Generated method ♦**" 

"somePayments assertAllType: Telecom_Payment." 
payments replaceWithElements: somePayments. 
self ooUpdate. 
self changed: #payments.! 



!Telecom_Account methodsFor: 'Generated - copying'! 
postCopy 

"*** Generated method ***" 

super postCopy. 

billingAddress := billingAddress copy. 
billingMethod := billingMethod copy, 
payments ™ payments collect: [:x | x copy], 
lines := lines copy.! 



!Telecom_Account methodsFor: 'Generated - accessing'! 
removeLine: aLine 

»••* Generated method ***" 



"aLine assertType: Telecom_Line." 
lines removeElement: aLine. 
self ooUpdate. 
self changed: #lines.! 
removePayment: aPayment 

"*** Generated method ***" 



"aPayment assertType: Telecom_Payment." 
payments removeElement: aPayment. 
self ooUpdate. 
self changed: #payments.l 



Smalltalk defineClass: #Telecom_Address 

superclass: #{Core.Object} 
indexedType: #none 
private: false 
instance VariableNames: 1 

city <ooVString> 

country <ooVString> 

postalCode <ooVString> 

state <ooVString> 

street ^oVString^ 
classInstanceVariableNames: " 
imports: " 

category: 'Generated Code - Applications.GeneratedCodeApp'! 
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!Telecom_Address class methodsFor: 'Generated - instance creation'! 
new 

"*** Generated method ***" 



A super new initializeAddress! 

t 



!Telecom_Address class methodsFor: 'private: generated'! 
ooCodeGen Vers ion 

A l! . 

ooTypedlnstanceVariablesString 



city <ooVString> 
country <ooVString> 
postalCode <ooVString> 
state <ooVString> 
street <ooVString>'! 



!Telecom_Address methodsFor: 'Generated - comparing'! 
= other 

Generated method 

other = self ifTrue: [ A true]. 

other ooClass = self ooClass ifFalse: [ A false]. 

self city = other city ifFalse: [ A false]. 

self street = other street ifFalse: [ A false]. 

self country = other country ifFalse: [ A false]. 

self state - other state ifFalse: [ A false]. 

self postalCode = other postalCode ifFalse: [ A false]. 

A true! 



!Telecom_Address methodsFor: 'Generated - assignment'! 
assignFrom: other 

Generated method 

other = self ifTrue: [ A selfJ. 

[other ooClass = self ooClass] assert. 

self city: other city. 

self street: other street. 

self country: other country. 

self state: other state. 

self postalCode: other postalCode.! 



!Telecom_Address methodsFor: 'Generated - accessing*! 
city 

Generated method **•" 

city assertTypeOrNil: String. r 
A city! 
city: aString 

Generated method 

aString assertTypeOrNil: String, 
city :- aString. 
self changed: #city.! 
clearCity 

M *** Generated method *♦•" 

city := ". 

self changed: #city.! 
clearCountry 

Generated method ***" 

country := ". 

self changed: #country.! 
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clearPostalCode 

"*** Generated method 

postalCode := 
self changed: #postalCode.! 
clearState 

"•** Generated method 

state := ". 

self changed: #state.! 
clearStreet 

"*•* Generated method 

street := 

self changed: #street.! 



!Telecom_Address methodsFor: 'Generated - clustering'! 
clusterWith: anObjectToClusterWith 
. "*** Generated method 

anObjectToClusterWith mioCluster: self.! 



!Telecom_Address methodsFor: 'Generated - accessing'! 
country 

Generated method ***" 

country assertTypeOrNil: String. 
A country! 
country: aString 

Generated method ***" 

aString assertTypeOrNil; String, 
country := aString. 
self changed: #country.! 



!Telecom_Address methodsFor: 'Generated - deletion'! 
delete 

"*** Generated method ***" 

selfooIsPersistent itTalse: [ A self]. 
selfooDelete.! 

i 



!Telecom_Address methodsFor: 'Generated - comparing'! 
hash 

Generated method ***" 

| runningHash | 
runningHash := 0. 

runningHash := (city goodHash + runningHash) timesRandomMultiplier. 
runningHash := (street goodHash + runningHash) timesRandomMultiplier. 
runningHash := (country goodHash + runningHash) timesRandomMultiplier. 
runningHash :- (state goodHash + runningHash) timesRandomMultiplier. 
runningHash := (postalCode goodHash + runningHash) timesRandomMultiplier. 
A runningHashbitXor: 16r05E7054E! 
hasSameUniquenessKeysAs: other 
"*** Generated method ***" 

other — self ifTrue: [ A true]. 

other ooClass = self ooClass ifFalse: [ A false]. 

Atrue! 



97 



!Telecom_Address methodsFor: 'Generated - initialization'! 
initializeAddress 

"*** Generated method ***" 

city := 
street := ". 
country := ". 
state := ". 
postalCode := "J 



!Telecom_Address methodsFor: 'Generated - accessing'! 
postalCode 

Generated method ***" 



. postalCode assertTypeOrNil: String. 
"postalCode! 
postalCode: aString 

"*** Generated method ***" 

aString assertTypeOrNil: String. 
postalCode := aString. 
self changed: #postalCode.! 

state 

"*** Generated method ***" 

state assertTypeOrNil: String. 
A state! 
state: aString 

"*** Generated method 

aString assertTypeOrNil: String, 
state :«■ aString. 
self changed: #state.! 

street 

Generated method 

street assertTypeOrNil: String. 
A street! 
street: aString 

"*** Generated method ***" 

aString assertTypeOrNil: String, 
street := aString. 
self changed: #street.! 

i 



Smalltalk defineClass: #Telecom_BillingMethod 

superclass: #{ Core. Object} 
indexedType: #none 
private: false 

instance VariableNames: " 
classInstanceVariableNames: " 
imports: " 

category: 'Generated Code - Applications. GeneratedCodeApp'! 



!Telecom_BillingMethod methodsFor: 'Generated - comparing'! 
= other 

"*** Generated method ***" 

other — self ifTrue: [ A true]. 

other ooClass = self ooClass ifFalse: [ A falsej. 

A true! 
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!Telecom_BillingMethod methodsFor: 'Generated - assignment*! 
assign From: other 

"**♦ Generated method ***" 

other = self ifTrue: [ A self|. 

[other ooClass = self ooClass] assert.! 



!Telecom_BillingMethod methodsFor: 'Generated - clustering'! 
clusterWith: anObjectToClusterWith 
Generated method 



anObjectToClusterWith mioCluster: self.! 



!Telecom_BillingMethod methodsFor: 'Generated - deletion'! 
delete 

"*** Generated method ***" 

self oolsPersistent ifFalse: [ A self]. 
selfooDelete! 

i 



!Telecom_BillingMethod methodsFor: 'Generated - comparing'! 
hash 

"**• Generated method ***" 

| runningHash | 
runningHash := 0. 

A runningHash bitXor: 1 6r05E7054E! 
hasSameUniquenessKeysAs: other 
Generated method *** M 

other = self ifTrue: [ A true]. 

other ooClass = self ooClass ifFalse: [ A false). 

A true! 



Smalltalk defmeClass: #TeIecom_AutomaticCreditCardBi11ing 

superclass: #{Telecom_BillingMethod} 
indexedType: #none 
private: false 

instanceVariableNames: " 
classInstanceVariableNames: " 
imports: " 

category: 'Generated Code - Applications. GeneratedCodeApp'! 



!Telecom_AutomaticCreditCardBilling methodsFor: 'Generated - comparing'! 
mother 

Generated method 



other = self ifTrue: [ A true]. 

other ooClass == self ooClass ifFalse: [ A false]. 

super - other ifFalse: [ A false]. 

A true! 



!Telecom_AutomaticCreditCardBilling methodsFor: 'Generated - assignment'! 
assignFrom: other 

"*** Generated method 



other = self ifTrue: [ A self|. 

[other ooClass — self ooClass] assert. 

super assignFrom: other.! 
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!Te1ecom_AutomaticCreditCardBilling methodsFor: 'Generated - deletion'! 
delete 

"*** Generated method ***" 

self oolsPersistent ifFalse: [ A self]. 
super delete.! 



!Telecom_AutomaticCreditCardBilling methodsFor: 'Generated - comparing'! 
hash 

Generated method ***" 

| runningHash | 
runningHash :- super hash. 
A runningHash bitXor: 16r05E7054E! 



Smalltalk defineClass: #Telecom_MonthiyInvoice 
superclass: #{Telecom_BillingMethod} 
indexedType: #none 
private: false 
instanceVariableNames: " 
classInstanceVariableNames: " 
imports: " 

category: "Generated Code - Applications. Genera tedCodeApp 1 ! 



!Telecom_Monthlylnvoice methodsFor: 'Generated - comparing'! 
= other 

"*** Generated method ***" 

other = self ifTrue: [ A true]. 

other ooClass = self ooClass ifFalse: [ A false]. 

super - other ifFalse: [ A false]. 

A true! 

i 



!Telecom_MonthlyInvoice methodsFor: 'Generated - assignment'! 
assignFrom: other 

Generated method 

other = self ifTrue: [ A self]. 

[other ooClass = self ooClass] assert. 

super assignFrom: other.! 



! Telecom Jvlonthly In voice methodsFor: 'Generated - deletion'! 
delete 

"*** Generated method *** M 

self oolsPersistent ifFalse: [ A self]. 
super delete.! 

! . 

!Telecom_Monthly Invoice methodsFor: 'Generated - comparing'! 
hash 

Generated method 

| runningHash | 
runningHash :- super hash. 
A runningHashbitXor: 16rO5E7054E! 

t 
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Smalltalk defineClass: #Telecom_Bil1ingPfan 
superclass: #{Core.Object} 
indexedType: #none 
private: false 
instance VariableNames: ' 

effective <uint64> 

end <uint64>* 
classInstanceVariableNames: " 
imports: M 

category: 'Generated Code - Applications.GeneratedCodeApp'! 

!Telecom_BillingPlan class methodsFor: 'Generated - instance creation'! 
new 

"*** Generated method ***" 
A supernew initializeBillingPlan! 



!Telecom_BillingPlan class methodsFor: 'private: generated'! 
ooCodeGen Version 

A 1! 

ooTypedlnstanceVariablesString 

A • 

effective <uint64> 
end <uint64>'! 



!Telecom_BillingPlan methodsFor: 'Generated - comparing'! 
= other 

" * * * Generated method * * * " 

other — self ifTrue: [ A true]. 

other ooClass == self ooClass ifFalse: [ A false]. 

self effective = other effective ifFalse: [ A false]. 

self end = other end ifFalse: [ A false]. 

A true! 



!Telecom_BillingPlan methodsFor: 'Generated - assignment'! 
assignFrom: other 

"*** Generated method 

other = self ifTrue: [ A self]. 
[other ooClass = self ooClass] assert, 
self effective: other effective, 
self end: other end.! 

i 



!Telecom_BillingPlan methodsFor: 'Generated - accessing'! 
clearEffective 

"•** Generated method *** H 

effective := 0. 
self changed: #effective.! 
clearEnd 

Generated method 
end := 0. 

self changed: #end.! 

t 



!Te1ecom_BillingPlan methodsFor: 'Generated - clustering'! 
clusterWith: anObjectToClusterWith 
"*** Generated method 

anObjectToClusterWith mioCluster: self.! 

i 
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!Telecom_BillingPlan methodsFor: 'Generated - deletion'! 
delete 

"*** Generated method ***" 

selfooIsPersistentifFalse: [ A self|. 
selfooDelete.! 



!Telecom_BillingPlan methodsFor: 'Generated - accessing'! 
effective 

" * * * Generated method * * * " 

(Timestamp fromMilliseconds: effective) assertTypeOrNil: Timestamp. 
A (Timestamp fromMilliseconds: effective)! 
effective: aTimestamp 

"*** Generated method ***" 

aTimestamp assertTypeOrNil: Timestamp. 
effective :*= aTimestamp asMilliseconds. 
self changed: #effective.! 

end 

"*** Generated method ***" 

(Timestamp fromMilliseconds: end) assertTypeOrNil: Timestamp. 
A (Timestamp fromMilliseconds: end)! 
end: aTimestamp 

Generated method 

aTimestamp assertTypeOrNil: Timestamp, 
end := aTimestamp asMilliseconds. 
self changed: #end.! 



!Telecom_BillingPlan methodsFor: 'Generated - comparing'! 
hash 

Generated method ***" 

| runningHash | 
runningHash := 0. 

runningHash := (effective goodHash + runningHash) timesRandomMultiplier. 
runningHash := (end goodHash + runningHash) timesRandomMultiplier. 
A runningHash bitXor: 16r05E7054E! 
hasSameliniquenessKeysAs: other 
Generated method ***" 

other = self ifTrue: [ A true]. 

other ooClass ~ self ooClass ifFalse: [ A false]. 

A true! 

i 



!Telecom_Bi11ingPlan methodsFor: 'Generated - initialization'! 
initializeBillingPlan 

"*** Generated method ***" 

effective := 0. 
end :=0.! 

» 

Smalltalk defineClass: #Telecom_FlatRatePlan 

superclass: #{Telecom_BillingPlan} 
indexedType: #none 
private: false 

instance VariableNames: " 
classInstanceVariableNames: " 
imports: " 

category: 'Generated Code - Applications.GeneratedCodeApp'! 
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!Telecom_FlatRatePlan methodsFor: 'Generated - comparing'! 
= other 

"*** Generated method ***" 

other == self ifTrue: [ A true]. 

other ooClass = self ooClass ifFalse: [ A false]. 

super = other ifFalse: [ A false]. 

A true! 

i 



!Telecom_FlatRatePlan methodsFor: 'Generated - assignment'! 
assignFrom: other 

Generated method ***" 



other = self ifTrue: [ A self]. 

[other ooClass — self ooClass] assert. 

super assignFrom: other.! 



!Telecom_FlatRatePlan methodsFor: 'Generated - deletion'! 
delete 

"*** Generated method ***" 



selfooIsPersistent ifFalse: [ A self]. 
super delete.! 



!Telecom_FlatRatePlan methodsFor: 'Generated - comparing*! 
hash 

"*** Generated method 

| runningHash | 
runningHash := super hash. 
A runningHashbitXor: 16rO5E7054E! 

I 

Smalltalk defineClass: #Telecom_FriendsAndFamilyPlan 

superclass: #{Telecom_BillingPlan} 
indexedType: #none 
private: false 

instance VariableNames: " 
classInstanceVariableNames: " 
imports: " 

category: 'Generated Code - Applications.GeneratedCodeApp'! 

!Te1ecom_FriendsAndFamilyPlan methodsFor: 'Generated - comparing'! 
= other 

"•** Generated method ••*" 

other = self ifTrue: [ A true]. 

other ooClass = self ooClass ifFalse: [ A false]. 

super = other ifFalse: ^falscj^ 

A true! .if- 



!Telecom_FriendsAndFamilyPlan methodsFor: 'Generated - assignment'! 
assignFrom: other 

Generated method 

other = self ifTrue: [ A self]. 

[other ooClass = self ooClass] assert. 

super assignFrom: other.! 
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!Telecom_FriendsAndFamilyPlan methodsFor: 'Generated - deletion'! 
delete 

"*** Generated method ***" 

self oolsPersistent ifFalse: [ A self). 
super delete.! 



!Telecom_FriendsAndFamilyPlan methodsFor: 'Generated - comparing'! 
hash 

"*** Generated method ***" 

| runningHash | 
runningHash := super hash. 
A runningHash bitXor: 16r05E7054E! 



Smalltalk defineClass: #f elecom_CailRecord 
superclass: #{Core.Object} 
indexedType: #none 
private: false 
instanceVariableNames: 1 

changeNode <ChangeNode> 

indexingState <uint8> 

remotelndex Entries <ooVArray(IndexEntry)> 

locallndexEntries <ooVArray(ooShortRefi(IndexEntry))> 

duration <uint32> 

start <uint64>' 
classlnstanceVariableNames: " 
imports: " 

category: 'Generated Code - Applications.GeneratedCodeApp'! 

!Telecom_Call Record class methodsFor: 'Generated - instance creation' 
new 

"**♦ Generated method *♦*'* 
A supernew initializeCallRecord! 



!Telecom_CallRecord class methodsFor: 'private: generated'! 
ooCodeGen Version 

A 1! 

ooTyped Instance VariablesString 



changeNode <ChangeNode> 
indexingState <uint8> 

remotelndexEntries <ooVArray(lndexEntry)> 
locallndexEntries <ooVArray(ooShortRef(IndexEntry))> 
duration <uint32> 
start <uint64>M 



***** Generated method ***" 

other = self itTrue: [ A true]. 

other ooClass == self ooClass ifFalse: [ A false]. 

self start = other start ifFalse: [ A false]. 

self duration = other duration i(False: [ A false]. 

A true! 



A ' 
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!Telecom_Call Record methodsFor: 'Generated - assignment'! 
assignFrom: other 

"*** Generated method ***" 



other = self ifTrue: [^elf]. 

[other ooClass = self ooClass] assert. 

self start: other start. 

self duration: other duration.! 



!Te1ecom_Cal1 Record methodsFor: 'Generated - index entries'! 
beDeleting 

Generated method ***" 
[self isStable] assert. 

selfsetlndexingState: (indexingState bitOr: 1).! 
beReindexing 

."*** Generated method ***" 

[self isStable] assert. 

selfsetlndexingState: (indexingState bitOr: 2).! 
beStable 

"*** Generated method ***" 

[self isStable not] assert. 

selfsetlndexingState: (indexingState bitAnd: 3 bitlnvert).! 



!Telecom_Call Record methodsFor: 'Generated - accessing'! 
changeNode 

"*.** Generated method •**" 

A changeNode! 
changeNode: aChangeNode 
Generated method 

changeNode := aChangeNode.! 
clearDuration 

"*** Generated method •*•" 

duration := 16rFFFFFFFF. 
self changed: #duration.! 



!Telecom_Call Record methodsFor: 'Generated - index entries'! 
clearRequests 

"*** Generated method ***" 



selfsetlndexingState: (indexingState bitAnd: 12 bitlnvert). 



i 



!Telecom_Cal 1 Record methodsFor Xjenerated - accessing'! 
clearStart J3fe 
"*** Generated method 

start := 0. 

self changed: #start! 



!Telecom_CallRecord methodsFor: 'Generated - clustering'! 
clusterWith: anObjectToClusterWith 
"*•* Generated method 

anObjectToClusterWith mioCluster: self.! 
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!Telecom_CallRecord methodsFor: 'Generated - deletion'! 
delete 

"*** Generated method ***" 

self oolsPersistent ifFalse: [ A self|. 
local IndexEntries do: [tie | ie delete]. 
selfooDelete.! 



!Telecom_Call Record methodsFor: 'Generated - accessing'! 
duration 

"*** Generated method 

duration assertTypeOrNil: Integer, 
^duration! 
duration: anlnteger 

Generated method 

anlnteger assertTypeOrNil: Integer, 
duration := anlnteger. 
self changed: ^duration.! 

i 



!Telecom_CallRecord methodsFor: 'Generated - comparing 1 ! 
hash 

"*** Generated method 

| runningHash | 
runningHash := 0. 

runningHash := (start goodHash + runningHash) timesRandomMultiplier. 
runningHash := (duration goodHash + runningHash) timesRandomMultiplier. 
A runningHash bitXor: 16r05E7054E! 

i 



!Telecom_Call Record methodsFor: 'Generated - index entries'! 
hasRequestedDeletion 

"*** Generated method *+*" 

A (indexingState bitAnd: 4) -= 0! 
hasRequestedReindexing 

"*** Generated method ***" 

A (indexingState bitAnd: 8) 0! 

i 



!Telecom_Call Record methodsFor: 'Generated - comparing*! 
hasSameUniquenessKeysAs: other 
"*** Generated method ***" 

other = self ifTrue: [ A true]. 

other ooClass = self ooClass ifFalse: [ A false]. 

A true! 



!Tekcom_Call Record methodsFor: 'Generated - index entries'! 
indexingState 

"*** Generated method ***" 

A indexingState! 
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!Telecom_Call Record methodsFor: 'Generated - initialization'! 
initializeCallRecord 

"*** Generated method *•*" 

indexingState := 0. 

remotelndexEntries := OoV Array new. 
local IndexEn tries := OoV Array new. 
start := 0. 

duration := 16rFFFFFFFF.! 



!Telecom_Call Record methodsFor: 'Generated - index entries'! 
isDeleting 

"*** Generated method ***" 

A (indexingState bitAnd: 1) 0! 
isReindexing 

"*** Generated method •**" 

A (indexingState bitAnd: 2) ~= 0! 
isStable 

"*** Generated method ***" 

A (indexingState bitAnd: 3) = 0! 
local IndexEntries 

"*** Generated method ***" 

A locallndexEn tries! 
local IndexEntries: somelndexEntries 
" * * * Generated method * * * " 

somelndexEntries assertAHTypeOrNil: IndexEntry. 
local IndexEntries replaceWithElements: somelndexEntries. 
self ooUpdate.! 
localOrTransientlndexEntries 

"•*♦ Generated method ***" 

self isStable 

ifTrue: [ A self transientlndexEn tries] 
ifFalse: [ A self locallndex Entries].! 
privateSetlndexingState: anlnteger 
"*** Generated method ***" 

"Transcript crtab: 5; nextPutAll: 'indexingState: '; print: indexingState; nextPutAll: ' -> '; print: anlnteger; nextPutAll: ' 
indexingState := anlnteger.! 
remotelndexEntries 

"*** Generated method***" 

RemotelndexEntries! 
remotelndexEntries: somelndexEntries 
"*♦* Generated method***" 

"somelndexEntries assertAHTypeOrNil: IndexEntry." "Too expensive to check" 
remotelndexEntries replaceWithElements: somelndexEntries. 
self ooUpdate.! 
requestDeletion 

"*** Generated method ***^ 

[self isStable not] assert 
self setlndexingState: (indexingState bitOr: 4).! 
requestReindexing 

"*** Generated method ***" 

[self isStable not] assert, 
self setlndexingState: (indexingState bitOr: 8).! 
setlndexingState: anlnteger 

"*** Generated method ***" 

indexingState = anlnteger ifFalse: [self privateSetlndexingState: anlnteger].! 

i 
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!Telecom_Cal I Record methodsFor: 'Generated - accessing 1 ! 
start 

"*** Generated method ***" 

(Timestamp fromMilliseconds: start) assertTypeOrNil: Timestamp. 
"(Timestamp fromMilliseconds: start)! 
start: aTimestamp 

Generated method ***" 

aTimestamp assertTypeOrNil: Timestamp. 
start :* aTimestamp asMilliseconds. 
self changed: tfstart! 



!Telecom_Call Record methodsFor: 'Generated - index entries'! 
transientlndexEntries 

"*** Generated method ***" 

| transientlndexEntries | 

transientlndexEntries := OrderedCollection new. 
A transientlndexEntries asArray! 



Smalltalk defineClass: #felecom JnboundCallRecord 

superclass: #{Telecom_Cal1 Record} 
indexedType: #none 
private: false 
instanceVariableNames: ' 
callerLine <uint64>' 
classlnstanceVariableNames: " 
imports: " 

category: 'Generated Code - Applications. GeneratedCodeApp'! 

! Telecom JnboundCall Record class methodsFor: 'Generated - instance creation' 
new 

"*** Generated method ***" 

A super new initializelnboundCallRecord! 



!Telecom_InboundCallRecord class methodsFor: 'private: generated'! 
ooCodeGenVersion 

A 1! 

ooTyped Instance VariablesString 
callerLine <uint64>'! 

t 



ITelecomJnboundCallRecord methodsFor: 'Generated - comparing'! 
- other 

"*** Generated method 

other = self ifTrue: fHrue]. 

other ooClass = self ooClass ifFalse: [ A false]. 

super = other ifFalse: [ A false]. 

self callerLine - other callerLine ifFalse: [ A false]. 

A true! 

i 
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!Telecom_InboundCall Record methodsFor: 'Generated - assignment'! 
assign From: other 

"*** Generated method 



other = self ifTrue: [ A self). 

[other ooClass = self ooClass] assert. 

super assignFrom: other. 

self callerLine: other callerLine.! 



!Telecom_Inb6undCall Record methodsFor: 'Generated - accessing'! 
callerLine 

"*** Generated method ***" 

callerLine assertTypeOrNil: integer. 
A callerLine! 
callerLine: anlnteger 

."•*• Generated method 

anlnteger assertTypeOrNil: Integer. 
callerLine := anlnteger. 
self changed: #callerLine.! 
clearCallerLine 

"*** Generated method •*•" 

callerLine := 1 6rFFFFFFFFFFFFFFFF. 
self changed: #callerLine.! 



!Telecom_lnboundCallRecord methodsFor: 'Generated - deletion'! 
delete 

Generated method ***" 

selfooIsPersistent iflFalse: [ A selfj. 
super delete.! 



!Telecom_InboundCallRecord methodsFor: 'Generated - comparing'! 
hash 

Generated method ***" 

J runningHash | 
runningHash := super hash. 

runningHash := (callerLine goodHash + runningHash) timesRandomMultiplier. 
A runningHash bitXor: 1 6r05E7054E! 



!TelecomJnboundCallRecord methodsFor: 'Generated - initialization'! 
initial izelnboundCallRecord 

M *** Generated method ***" 



Smalltalk defineClass: #Tele«oniidutb^ndCallReeord 

superclass: #{Telecom_CaHRecord} 
indexedType: #none 
private: false 
instance VariableNames: * 
calledLine <uint64>' 
classInstanceVariableNames: " 
imports: " 

category: 'Generated Code - Applications.GeneratedCodeApp'! 
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!Telecom_OutboundCal I Record class methodsFor: 'Generated - instance creation' 
new 

"*** Generated method ***** 

A super new initializeOutboundCallRecord! 



!Telecom_OutboundCall Record class methodsFor: 'private: generated'! 
ooCodeGenVersion 

A 1! 

ooTyped Instance VariablesString 

A • 

calledLine <uint64>'! 

i 



!Telecom_OutboundCall Record methodsFor: 'Generated - comparing'! 
= other 

••*** Generated method ***" 

other == self ifTrue: [ A true]. 

other ooClass — self ooClass ifFalse: [ A false]. 

super = other ifFalse: [ A false]. 

self calledLine = other calledLine ifFalse: [ A false]. 

A true! 

j 

!Telecom_OutboundCall Record methodsFor: 'Generated - assignment'! 
assignFrom: other 

Generated method ***" 

other == self ifTrue: [ A self]. 

[other ooClass = self ooClass] assert. 

super assignFrom: other. 

self calledLine: other calledLine.! 

t 



!Telecom_OutboundCall Record methodsFor: 'Generated - accessing'! 
calledLine 

"*** Generated method ***" 

calledLine assertTypeONil: Integer. 
A calledLine! 
calledLine: anlnteger 

"*** Generated method ***" 

anlnteger assertTypeOrNil: Integer. 
calledLine :- anlnteger. 
self changed: #calledLine.! 
clearCal led Line 

***** Generated method - 

calledLine := 1 6rFFFFFFFFTTFFFFFFF. 
self changed: #calledLine.!/ - 



!Telecom_OutboundCallRecord methodsFor: 'Generated - deletion*! 
delete 

"*** Generated method ***" 

self oolsPersistent ifFalse: [ A self|. 
super delete.! 

i 



no 



!Telecom_OutboundCallRecord methodsFor: 'Generated - comparing'! 
hash 

"*** Generated method ***" 

| runningHash | 
runningHash super hash. . 

runningHash := (calledLine goodHash + runningHash) timesRandomMultiplier. 
A runningHash bitXor: 16rO5E7054E! 



!Telecom_OutboundCall Record methodsFor: 'Generated - initialization'! 
initiaiizeOutboundCallRecord 
Generated method 

calledLine := 1 6rFFFFFFFFFFFFFFFF. ! 



Smalltalk defineClass: #Telecom_ContactChannel 
superclass: #{Core.Object} 
indexedType: #none 
private: false 
instance VariableNames: " 
classInstanceVariableNames: " 
imports: " 

category: 'Generated Code - Applications.GeneratedCodeApp'! 



!Telecom_ContactChannel methodsFor: 'Generated - comparing'! 
= other 

"**• Generated method ***" 

other — self ifTrue: [ A true].. . 

other ooClass = self ooClass ifFalse: [ A false]. 

A true! 



!Telecom_ContactChannel methodsFor: 'Generated - assignment'! 
assignFrom: other 

Generated method***" 

other = self ifTrue: [ A self]. 

[other ooClass — self ooClass] assert.! 



!Telecom_ContactChannel methodsFor: 'Generated - clustering'! 
clusterWith: anObjectToClusterWith 
"*** Generated method ***" 

anObjectToClusterWith mioCluster: self.! 



!Telecom_ContactChannel methodsFor: 'Generated - deletion'! 
delete ^ 
"*** Generated method ♦*^fr 

sel f oo IsPersistent ifFalse: [ A self]. 
self ooDelete.! 

i 
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!Telecom_ContactChannel methodsFor: 'Generated - comparing'! 
hash 

H *** Generated method *** n 

| runningHash | 
runningHash := 0. 

'RunningHash bitXor: 1 6r05E7054E! 
hasSameUniquenessKeysAs: other 
"**• Generated method ••*" 

other = self ifTrue: [ A true]. 

other ooClass = self ooClass ifFalse: [ A false]. 

A true! 



Smalltalk defineClass: #Telecom_CallCenter 

superclass: #{Telecom_ContactChannel} 
indexedType: #none 
private: false 
instanceVariableNames: " 
classInstanceVariableNames: " 
imports: " 

category: 'Generated Code - Applications.GeneratedCodeApp'! 

!Telecom_Cal1Center methodsFor: 'Generated - comparing'! 
= other 

"*** Generated method ***" 

other — self ifTrue: [ A true]. 

other ooClass == self ooClass ifFalse: [ A false]. 

super = other ifFalse: [ A false]. 

A true! 



!Telecom_CallCenter methodsFor: 'Generated - assignment'! 
assignFrom: other 

"**♦ Generated method ***" 

other = self ifTrue: [ A self]. 

[other ooClass — self ooClass] assert. 

super assignFrom: other.! 

i 



!Telecom_CallCenter methodsFor: 'Generated - deletion'! 
delete 

"*** Generated method **•" 

selfooIsPersistent ifFalse: [ A setf|. 
super delete.! 

i 



!Telecom_CallCenter rnethcKJsF<K^jcncrated - comparing'! 
hash |Sj£ ■ 

"*** Generated method 

| runningHash j 
runningHash := super hash. 
^nningHashbitXor: 16r05E7054E! 

t 

Smalltalk defineClass: #t eiecom_FacetoFace 
superclass: #{Telecom_ContactChannel} 
indexedType: #none 
private: false 

instanceVariableNames: " 
classInstanceVariableNames: " 
imports: " 

category: 'Generated Code - Applications.GeneratedCodeApp'! 
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!Telecom_FaceToFace methodsFor: 'Generated - comparing'! 
= other 

"*** Generated method 

other = self ifTrue: [ A true]. 

other ooClass = self ooClass ifFalse: [ A false]. 

super = other ifFalse: [ A false]. 

A true! 



!Telecom_FaceToFace methodsFor: 'Generated - assignment'! 
assign From: other 

"*** Generated method ***" 

other = self ifTrue: [ A self]. 

[other ooClass = self ooClass] assert. 

super assignFrom: other.! 

i 



!Telecom_FaceToFace methodsFor: 'Generated - deletion'! 
delete 

Generated method •***' 



selfooIsPersistent ifFalse: [ A self|. 
super delete.! 



!Telecom_FaceToFace methodsFor: 'Generated - comparing'! 
hash 

"*** Generated method ***" 



| runningHash | 
runningHash := super hash. 
^nningHash bitXor: 16r05E7054E! 



Smalltalk defineClass: #Telecom_Internet 

superclass: #{Telecom_ContactChannel} 

indexedType: #none 

private: false 

instance VariableNames: " 

classInstanceVariableNames: " 

imports: " 

category: 'Generated Code - Applications. GeneratedCodeApp*! 



!Telecom_Intemet methodsFor: 'Generated - comparing'! 
= other 

"*** Generated method ***" 

other = self ifTrue: [ A true]. 

other ooClass — self ooQass ifFalse: [ A false]. 

super = other ifFalse: [ A fala^; 

A true! "N§r;k*\ 



ITelecomJnternet methodsFor: 'Generated - assignment'! 
assignFrom: other 

"*** Generated method ***" 

other = self ifTrue: [ A self]. 

[other ooClass — self ooClass] assert. 

super assignFrom: other.! 
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!Telecom_Internet methodsFor: 'Generated - deletion*! 
delete 

"*** Generated method ***" 

self ooisPersistent ifFalse: [ A self|. 
super delete.! 



'Telecomjntemet methodsFor: 'Generated - comparing'! 
hash 

"*** Generated method***'' 

| runningHash | 
runningHash := super hash. 
A runningHash bitXor: 16r05E7054E! 



Smalltalk defineClass: #t elecomJVlail 

superclass: # {Telecom_ContactChannel } 
indexedType: #none 
private: false 

instanceVariableNames: " 
classInstanceVariableNames: " 
imports: " 

category: 'Generated Code - Applications. GeneratedCodeApp'! 

!Telecom_Mail methodsFor: 'Generated - comparing'! 
= other 

"*** Generated method ***" 

other = self ifTrue: [ A true]. 

other ooClass = self ooClass ifFalse: [ A false]. 

super = other ifFalse: [ A false]. 

A true! 

t 



!Telecom_Mail methodsFor: 'Generated - assignment'! 
assignFrom: other 

"**♦ Generated method ***" 

other = self ifTrue: ( A self). 

[other ooClass — self ooClass] assert. 

super assignFrom: other.! 



!Telecom_Mail methodsFor: 'Generated - deletion'! 
delete 

"*** Generated method ***" 

self ooisPersistent ifFalse: ['"self], 
super delete.! 

! ife. 

!Telecom_Mail methodsFor: K3enenited - comparing'! 
hash 

"*** Generated method ***" 

| runningHash | 
runningHash := super hash. 
-runningHash bitXor: 16r05E7054E! 
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Smalltalk defineClassr#Teiecom_ContactEvent 
superclass: #{Core.Object} 
indexedType: #none 
private: false 
instanceVariableNames: ' 

channel ^oShortReflTelecon^ContactChannel)^ 
class InstanceVariableNames: " 
imports: " 

category: 'Generated Code - Applications.GeneratedCodeApp'! 

!Telecom_ContactEvent class methodsFor: 'Generated - instance creation' 
new . 

"*** Generated method ***" 
A super new initializeContactEvent! 



!Telecom_ContactEvent class methodsFor: 'private: generated'! 
ooCodeGen Version 

A 1! 

ooTyped Instance VariablesString 

A » 

channel <ooShortRef(Telecom_ContactChannel)>' ! 



!Telecom_ContactEvent methodsFor: 'Generated - comparing'! 
= other 

Generated method 

other = self ifTrue: [ A true]. 

other ooClass = self ooClass ifFalse: [ A false]. 

self channel = other channel ifFalse: [ A false]. 

Atrue! 

t 



!Telecom_ContactEvent methodsFor: 'Generated - assignment'! 
assignFrom: other 

"*** Generated method ***" 

other = self ifTrue: [ A self|. 

[other ooClass ==. self ooClass] assert. 

self channel ooClass = other channel ooClass 

ifTrue: [self channel assignFrom: other channel] 
ifFalse: [ 

self channel delete. 

self channel: other channel].! 

t 



!Telecom_ContactEvent methodsFor: 'Generated - accessing'! 
channel 

"*** Generated method 

channel assertTypeOrNil: Tc!cw>m_ContactChanneL 
A channel! ^£-f 
channel: aContactChannel 

"*** Generated method •*•" 

aContactChannel assertTypeOrNil: Telecom_ContactChannel. 
channel :- aContactChannel. 
self changed:. #channel.! 
clearChannel 

Generated method ***" 

channel delete, 
channel := nil. 
self changed: #channel.! 

i 
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!Telecom_ConlactEvent methodsFor: 'Generated - clustering'! 
ciusterWith: anObjectToClusterWith 
Generated method ***" 

anObjectToClusterWith mioCluster: self, 
channel ciusterWith: self.! 



!Telecom_ContactEvent methodsFor: 'Generated - deletion'! 
delete 

Generated method ***" 

self ooisPersistent ifPalse: [ A self|. 
channel delete. 
selfooDelete.! 

i . 



!Telecom_ContactEvent methodsFor: 'Generated - comparing*! 
hash 

Generated method ***" 

| runningHash | 
runningHash := 0. 

runningHash := (channel goodHash + runningHash) timesRandomMultiplier. 
A runningHash bitXor. 16rO5E7054E! 
hasSameUniquenessKeysAs: other 
Generated method •**" 

other = self ifTrue: [ A true]. 

other ooClass = self ooClass ifFalse: [ A false]. 

A true! 



!Telecom_ContactEvent methodsFor: 'Generated - initialization'! 
initial izeContactEvent 

"•*• Generated method ***" 

channel := Telecom_ContactChannel new.! 



!Telecom_ContactEvent methodsFor: 'Generated - copying'! 
postCopy 

Generated method 

super postCopy. 
channel := channel copy.! 

! 

Smalltalk defineClass: #Telecom_ChangeAddress 
superclass: # {Telecom^ContactEvent} 
indexedType: #none 
private: false 
instance VariableNames: 1 

newAddress <ooShortRef(Telecom_Address)>' 
classInstanceVariableNamcs: " 
imports: " 

category: 'Generated Code - Applications.GeneratedCodeApp'! 

!Telecom_ChangeAddress class methodsFor: 'Generated - instance creation'! 
new 

"*** Generated method 

A super new initializeChangeAddress! 

t 
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!Telecom_Change Address class methodsFor: 'private: generated'! 
ooCodeGenVersion 

A 1! 

ooTyped Instance VariablesString 

newAddress<ooShortRef(Tetecom_Address)>'! 



!Telecom_Change Address methodsFor: 'Generated - comparing'! 
= other 

"*** Generated method ***" 

other = self ifTrue: [ A true]. 

other ooClass = self ooClass ifFalse: [ A false]. 

super = other ifFalse: [ A false]. 

self newAddress = other newAddress ifFalse: [ A false]. 

A true! 



!Telecom_ChangeAddress methodsFor: 'Generated - assignment'! 
assignFrom: other 

Generated method ♦**" 

other = self ifTrue: [ A self]. 

[other ooClass = self ooClass] assert. 

super assignFrom: other. 

self newAddress ooClass — other newAddress ooClass 

ifTrue: [self newAddress assignFrom: other newAddress] 
ifFalse: [ 

self newAddress delete. 

self newAddress: other newAddress].! 

i 



!Telecom_ChangeAddress methodsFor: 'Generated - accessing'! 
clearNewAddress 

"*** Generated method ***" 

newAddress delete. 
newAddress := nil. 
self changed: #newAddress.! 



!Telecom_Change Address methodsFor: 'Generated - clustering'! 
clusterWith: anObjectToClusterWith 
Generated method ***" 

super clusterWith: anObjectToClusterWith. 
newAddress clusterWith: self.! 



!Telecom_Change Address ir*thb&Fon 'Generated - deletion'! 
delete * r> " 
"*** Generated method 



selfooIsPersistent ifFalse: [ A self]. 
newAddress delete, 
super delete.! 
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!Telecom_Change Address methodsFor: 'Generated - comparing'! 
hash 

"*** Generated method ***" 

| runningHash | 
runningHash := super hash. 

runningHash := (newAddress goodHash + runningHash) timesRandomMultiplier. 
A runningHash bitXor: 16r05E7054E! 



!Telecom_Change Address methodsFor: 'Generated - initialization'! 
initializeChangeAddress 

"*** Generated method ***" 

newAddress := Telecom Address new.! 



!Telecom_ChangeAddress methodsFor: 'Generated - accessing'! 
newAddress 

Generated method *•*" 

newAddress assertTypeOrNil: Telecom_Address. 
NewAddress! 
newAddress: anAddress 

"•** Generated method 

anAddress assertTypeOrNil: Telecom_Address. 
newAddress := anAddress. 
self changed: #newAddress.! 



!TeIecom_ChangeAddress methodsFor: 'Generated - copying'! 
postCopy 

"*** Generated method 

super postCopy. 

newAddress newAddress copy.! 

i 



Smalltalk defineClass: #Telecom_ChangeName 
superclass: # {Telecom_ContactEvent} 
indexedType: #none 
private: false 
instanceVariableNames: ' 

newName ^oShortReffTelecomJ^ame)^ 
classInstanceVariableNames: " 
imports: " 

category: 'Generated Code - Applications.GeneratedCodeApp'! 

!Telecom_ChangeName class methodsFor: 'Generated - instance creation'! 
new 

"*** Generated method •••"^ 
A super new initiaHzeChangefteroe! 



!Telecom_ChangeName class methodsFor: 'private: generated'! 
ooCodeGenVersion 

A 1! 

ooTypedlnstanceVariablesString 

A « 

newName <ooShortRef(Telecom_Name)>'! 

! 



118 



!Telecom_ChangeName methodsFor: 'Generated - comparing'! 
= other 

"*** Generated method ***" 

other = self ifTrue: [ A true]. 

other ooClass = self ooClass ifFalse: [ A false]. 

super = other ifFalse: [ A false]. 

self newName = other newName ifFalse: [ A false]. 

A true! 



!Telecom_ChangeName methodsFor: 'Generated - assignment'! 
assignFrom: other 

""♦Generated method***" 

other = self ifTrue: [ A self|. 

[other ooClass = self ooClass) assert. 

super assignFrom: other. 

self newName ooClass = other newName ooClass 

ifTrue: [self newName assignFrom: other newName] 
itTalse: [ 

self newName delete. 

self newName: other newName].! 



!Telecom_ChangeName methodsFor: 'Generated - accessing'! 
clearNewName 

"*** Generated method ***" 

newName delete. 
newName := nil. 
self changed: #newName.! 



!Telecom_ChangeName methodsFor: 'Generated - clustering'! 
clusterWith: anObjectToClusterWith 
"*♦* Generated method ***" 

super clusterWith: anObjectToClusterWith. 
newName clusterWith: self.! 



!Telecom_ChangeName methodsFor: 'Generated - deletion'! 
delete 

"*** Generated method ***" 

self oolsPersistent ifFalse: [ A selfj. 
newName delete, 
super delete.! . 



!Telecom_ChangeName methodsFor: 'Generated • comparing'! 
hash 

"*** Generated method ***" 

| runningHash | 
runningHash := super hash. 

runningHash := (newName goodHash + runningHash) timesRandomMultiplier. 
A runningHash bitXor: 16rO5E7054E! 

t 



!Telecom_ChangeName methodsFor: 'Generated - initialization'! 
initializeChangeName 

"♦** Generated method ***" 

newName := Telecom_Name new.! 
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!Telecom_ChangeName methodsFor: 'Generated - accessing'! 
newName 

"**• Generated method ***" 



newName assertTypeOrNil: Telecom_Name. 
NewName! 
newName: aName 

Generated method •**" 

aName assertTypeOrNil: Telecom_Name. 
newName := aName. 
self changed: #newName.! 



!Telecom_ChangeName methodsFor: 'Generated - copying'! 
postCopy 

"*** Generated method 

super postCopy. 

newName :- newName copy.! 



Smalltalk defineClass: #Telecom_ChangePlan 
superclass: #{Telecom_ContactEvent} 
indexedType: #none 
private: false 

instance VariableNames: " 
classInstanceVariableNames: " 
imports: " 

category: 'Generated Code - Applications.GeneratedCodeApp'! 

!Telecom_ChangePlan methodsFor: 'Generated - comparing'! 
= other 

"*** Generated method 

other — self ifTrue: [ A true]. 

other ooClass = self ooClass ifFalse: [ A false]. 

super - other ifFalse: [ A false]. 

A true! 



!Telecom_ChangePlan methodsFor: 'Generated * assignment'! 
assignFrom: other 

"*»* Generated method ***" 

other = self ifTrue: [ A self|. 

[other ooClass == self ooClass] assert. 

super assignFrom: other.! 



!Telecom_ChangePlan methodsFor: 'Generated - comparing'! 
hash 

"*** Generated method 

| runningHash | 
runningHash := super hash. 
^nningHash bitXor: 16r05E7054E! 



!TeIecom_ChangePlan methodsFw/Generated - deletion'! 
delete z B-£? 



"*** Generated method ; 



self oolsPersistent ifFalse: [4df). 
super delete.! 
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Smalltalk deflneClass: #Telecom_NewLine 
superclass: #{Telecom_ContactEvent} 
indexedType: #none 
private: false 

instanceVariableNames: M 
classInstanceVariableNames: " 
imports: " 

category: 'Generated Code - Applications. GeneratedCodeApp'! 

ITelecom_NewLine methodsFor: 'Generated - comparing'! 
= other 

Generated method ***" 

other = self ifTrue: [ A true]. 

other ooClass = self ooClass ifFalse: [ A false]. 

super = other ifFalse: [ A false]. 

A true! 



!Telecom_NewLine methodsFor: 'Generated - assignment'! 
assignFrom: other 

Generated method ***" 

other = self ifTrue: [ A selfj. 

[other ooClass = self ooClass] assert. 

super assignFrom: other.! 



!TelecomJMewLine methodsFor: 'Generated - deletion'! 
delete 

"*** Generated method *••" 

self oolsPersistent ifFalse: [ A self]. 
super delete.! 



!Telecom_NewLine methodsFor: 'Generated - comparing'! 
hash 

Generated method 

| runningHash | 
runningHash := super hash. 
A runningHash bitXor: 16r05E7054E! 

! 

Smalltalk defineClass: #Telecom_Line_byNumber 
superclass: #{IndexEntry} 
indexedType: #none 
private: false 
instanceVariableNames: ' 

number <uint64>' 
classInstanceVariableNames: " 
imports: " 

category: 'Generated Code <Aj^fications.GeneratedCodeApp'! 

!Telecom_Line_byNumber class methodsFor: •Generated'! 
indexEntriesFor: aLine 
"*** Generated code 

| entries template | 

entries := OrderedCollection new. 

template := self new. 

template indexedObject: aLine. 

template number: aLine number. 

entries add: template copy. 

A entries! 

i 
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!Telecom_Line_byNumber class methodsFor: 'private: generated'! 
ooCodeGenVersion 



A 1! 

ooTypedlnstanceVariablesString 



A • 



number <uint64>*! 



!Telecom_Line_byNumber methodsFor: 'Generated - comparing'! 
= other 

"♦** Generated method ***" 

other = self ifTrue: [ A true]. 

other ooClass = self ooClass ifFalse: [ A false]. 

self number = other number ifFalse: [ A false]. 

A true! 



!TelecomJJne_byNumber methodsFor: 'Generated - comparing'! 
hash 

"*** Generated method ***" 

| runningHash | 
runningHash := 0. 

runningHash := (self number goodHash + runningHash) timesRandomMultiplier. 
'VunningHash bitXor: 16rO5E7054E! 
hashOfKey 

"*** Generated method ***" 

| runningHash | 
runningHash := 0. 

runningHash := (self number goodHash + runningHash) timesRandomMultiplier. 
A runningHash bitXor: 16r05E7054E! 
hasSameKeyAs: other 

"*** Generated method ***" 

other — self ifTrue: [ A true]. 

other ooClass = self ooClass ifFalse: [ A false]. 

self number = other number ifFalse: [ A false]. 

A true! 



!Telecom_Line_byNumber methodsFor: 'Generated - assignment'! 
assignFrom: other 

Generated code 



number := other number.! 



!Telecom_Line_byNumber methpdsFon 'Generated - initialization'! 
initialize ISA 
"*** Generated code ***^fevv 




number := 1 6rF] 
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!Telecom_Line_byNumber methodsFor: 'Generated - accessing'! 
number 

Generated method 

number assertTypeOrNil: Integer, 
dumber! 
number: anlnteger 

"*•• Generated method *** M 

anlnteger assertTypeOrNil: Integer, 
number :- anlnteger. 
self changed: #number.! 

t 



!Telecom_Line_byNumber methodsFor: 'Generated - searching'! 
searchByExample: session 

"*** Generated code ***" 

| clauses predicate | 

clauses := OrderedCollection new. 

clauses add: 'number - ', (Smalltalklnteger convertToPredicateConstant: number)], 
predicate :- WriteStream on: (String new: 100). 
clauses 

do: [:clause | predicate nextPutAll: clause] 
separatedBy: [predicate nextPutAll: ' && *]. 
A (self targetContainerln: session) 
scan: self ooClass 
predicate: predicate contents! 



Smalltalk defineClass: #Telecom_Line 

superclass: #{Core.Object} 

indexedType: #none 

private: false 

instanceVariableNames: ' 

calls <ooVArray(Telecom_CallRecord)> 
location <ooShortRefi(Telecom_Address)> 
number <uint64> 

plans <ooVArray(ooShortRefi(Telecom_BillingPlan))>' 
classInstanceVariableNames: " 
imports: " 

category: 'Generated Code - Applications.GeneratedCodeApp'! 

!Telecom_Line class methodsFor: 'Generated - instance creation'! 
new 

Generated method 
A super new initializeUne! 

i 



!Telecom_Line class methodsFar^Jpvate: generated'! 
ooCodeGenVersion ^M^ : 

•• 

ooTypedlnstanceVariablesString.^ 

calls <ooVArray(Telecom_CallRecord)> 
location <ooShortRefi(Telecom_Address)> 
number <uint64> 

plans <ooVATTay(ooShortRefi(Telecorn_BillingPlan))>*! 
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!Telecom_Line methodsFor: 'Generated - comparing'! 
= other 

Generated method ***" 



other = self ifTrue: [ A true]. 

other ooClass — self ooClass ifFalse: [ A false]. 

self number - other number ifFalse: [ A false]. 

self plans = other plans ifFalse: [ A false]. 

self location = other location ifFalse: [ A false]. 

self calls = other calls ifFalse: [ A false]. 

A true! 



!Telecom_Line methodsFor: 'Generated - accessing'! 
addCall: aCallRecord 

"*** Generated method ***" 

"aCallRecord assertType: Telecom_CallRecord." 
calls add Element: aCallRecord. 
self ooUpdate. 
self changed: #calls.! 
addPlan: aBillingPlan 

Generated method 

"aBillingPlan assertType: Telecom_BillingPlan." 

plans addElement: aBillingPlan. 

self ooUpdate. 

self changed: #plans.! 



!Telecom_Line methodsFor: 'Generated - assignment'! 
assignFrom: other 

"*** Generated method ***" 

other = self ifTrue: [ A se1f|. 
[other ooClass — self ooClass] assert, 
self number: other number, 
self plans = other plans ifFalse: [ 

self plans do: [:x | x delete]. 

self plans: other plans], 
self location ooClass = other location ooClass 

ifTrue: [self location assignFrom: other location] 

ifFalse: [ 

self location delete, 
self location: other location], 
self calls: other calls.! 



!Telecom_Line methodsFor: 'Generated - accessing'! 
calls 

Generated method 

"calls assertAUType: Teleconi_CallRecord." 
A calls! ;■: 
calls: someCall Records \- ■ 

Generated method 

"someCallRecords assertAUType: Telecom_CallRecord.' 
calls replace WithElements: someCallRecords. 
self ooUpdate. 
self changed: #calls.! 
clearCalls 

"*** Generated method ***" 

calls do: [:x | x delete]. 

calls replace WithElements: #(). 

self ooUpdate. 

self changed: #calls.! 
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clearLocation 

"*** Generated method ***' 



location delete, 
location := nil. 
self changed: location.! 
clearNumber 

"*** Generated method ***" 

number := 1 6rFFFFFFFFFFFFFFFF. 
self changed: #number.! 
clearPlans 

"*** Generated method ***" 

plans do: [:x | x delete]. 

plans replace With Elements: #(). 

self ooUpdate. 

self changed: #plans.! 

! 



!Telecom_Line methodsFor: 'Generated - clustering'! 
clusterWith: anObjectToClusterWith 
•*•* Generated method ***" 

anObjectToClusterWith mioCluster: self, 
plans do: [:x | x clusterWith: self), 
location clusterWith: self.! 



!Telecom_Line methodsFor: 'Generated - deletion'! 
delete 

• "••♦Generated method***" 

self oolsPersistent ifFalse: [ A self]. 
plans do: [:x | x delete], 
location delete, 
self oo Delete.! 

i 



!Telecom_Line methodsFor: 'Generated - comparing'! 
hash 

"*** Generated method ***" 

| runningHash | 
runningHash := 0. 

runningHash := (number goodHash + runningHash) timesRandomMultiplier. 
runningHash := ((plans sum: [:x | x goodHash]) + runningHash) timesRandomMultiplier. 
runningHash := (location goodHash + runningHash) timesRandomMultiplier. 
runningHash := ((calls sum: [:x | x goodHash]) + runningHash) timesRandomMultiplier. 
A runningHash bitXor: 1 6rO5E7054E! 
hasSameUniquenessKeysAs: other 
"*** Generated method *** M 

other = self ifTrue: [ A true]. 

other ooClass = self ooClaw-ifFalse: [ A false]. 

self number = other numb^^Use: [ A false]. 

A true! ^t:/. 



!Telecom_Line methodsFor: 'Generated - initialization'! 
initializeLine 

"*** Generated method ***" 

number := 1 6rFFFFFFFFFFFFFFFF. 
plans := OoV Array new. 
location Telecom^Address new. 
calls := OoV Array new.! 

! 
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!Telecom_Line methodsFor: 'Generated - accessing'! 
location 

Generated method ***" 

location assertTypeOrNil: Telecom_Address. 
"location! 
location: anAddress 

"*** Generated method *♦•" 

anAddress assertTypeOrNil: Telecom_Address. 
location :- anAddress. 
self changed: #location.! 
number 

"*** Generated method ***" 

number assertTypeOrNil: Integer, 
"number! 
number: an Integer 

"*** Generated method 

an Integer assertTypeOrNil: Integer, 
number :- an Integer, 
self changed: #number.! 

plans 

"*** Generated method ***" 

"plans assertAUType: Telecom_BillingPlan." 
A plans! 
plans: someBilHngPlans 

"**■• Generated method ***" 

"someBilHngPlans assertAUType: Telecom_BillingPlan." 

plans replaceWithElements: someBilHngPlans. 

self ooUpdate. 

self changed: #plans.! 



!Telecom_Line methodsFor: 'Generated - copying'! 
postCopy 

Generated method ***" 
super postCopy. 

plans := plans collect: [:x | x copy], 
location :- location copy, 
calls := calls copy.! 

i 



!Telecom_Line methodsFor: 'Generated - accessing'! 
removeCall: aCall Record 

"*** Generated method ***" 

"aCall Record assertType: Telecom_CallRecord." 
calls removeElement: aCallRecord. 
self ooUpdate. 
self changed: #calls.! 
removePlan: aBillingPlan 

Generated method **** - 

"aBillingPlan assertType: Telecom_BillingPlan." 

plans removeElement: aBillingPlan. 

self ooUpdate. 

self changed: #plans.! 

i 
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Smalltalk defineClass: #Telecom_Name 
superclass: #{Core.Object} 
indexedType: #none 
private: false 
instanceVariableNames: * 

designation <ooVString> 

first <ooVString> 

generation <ooVString> 

last <ooVString> 

middle <ooVString> 

prefix <ooVString>* 
class InstanceVariableNames: " 
imports: " 

category: 'Generated Code - Applications.GeneratedCodeApp'! 

!Telecom_Name class methodsFor: 'Generated - instance creation*! 
new 

M *** Generated method ***" 
A super new initializeName! 



!Telecom_Name class methodsFor: 'private: generated'! 
ooCodeGen Version 

A 1! 

ooTyped Instance VariablesString 



designation <ooVString> 
first <ooVString> 
generation <ooVString> 
last <ooVString> 
middle <ooVString> 
prefix <ooVString>'! 



!Telecom_Name methodsFor: 'Generated - comparing'! 
= other 

Generated method 

other = self ifTrue: [ A true]. 

other ooClass = self ooClass ifFalse: [ A false]. 

self first = other first ifFalse: [ A false]. 

self last = other last ifFalse: [ A false]. 

self middle = other middle ifFalse: [ A false]. 

self prefix - other prefix ifFalse: [ A false]. 

self generation = other generation ifFalse: [ A false]. 

self designation = other designation ifFalse: [ A false]. 

A true! 



!Telecom_Name methodsFor: 'Generated - assignment'! 
assignFrom: other -t&^t^r 



other = self ifTrue: [^If^^' 
[other ooClass = self ooClass] assert, 
self first: other first, 
self last: other last, 
self middle: other middle, 
self prefix: other prefix, 
self generation: other generation, 
self designation: other designation.! 



"*** Generated method 
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!Te1ecom_Name methodsFor: 'Generated - accessing'! 
clearDesignation 

Generated method ***" 

designation := 

self changed: ^designation.! . 
clearFirst 

Generated method 

first := 

self changed: #first.! 
clearGeneration 

Generated method ***" . 

generation := 

self changed: ^generation.! 
clearLast 

"*** Generated method 

last:=". 

self changed: #last! 
clearMiddle 

"*** Generated method 

middle := 

self changed: #middle.! 
clearPrefix 

Generated method ***" 
prefix := ". 

self changed: #prefix.! 

i 



!Telecom_Name methodsFor: 'Generated - clustering'! 
clusterWith: anObjectToClusterWith 
Generated method ***" 

anObjectToClusterWith mioCluster: self.! 



!Te1ecomJMame methodsFor: 'Generated - deletion*! 
delete 

Generated method ••*" 

self oolsPersistent ifFalse: [ A self]. 
selfooDelete.! 

t 



!Telecom_Name methodsFor: 'Generated - accessing'! 
designation 

"*** Generated method ***" 

designation assertTypeOrNil: String, 
designation! ■ 
designation: aString jM- 
"*** Generated method ••Sfe"^-- 

aString assertTypeOrNil: String, 
designation :- aString. 
self changed: #designation.! 

first 

"*** Generated method 

first assertTypeOrNil: String. 
A first! 
first: aString 

"♦*• Generated method *••" 



aString assertTypeOrNil: String, 
first := aString. 
self changed: #first.! 



generation 

"*** Generated method ***" 

generation assertTypeOrNil: String, 
"generation! 
generation: aString 

"*** Generated method ***" 

aString assertTypeOrNil: String, 
generation := aString. 
self charged: ^generation.! 

i 



!Telecom_Name methodsFor: 'Generated - comparing'! 
hash 

"*** Generated method ***** 

. | runningHash | 
runningHash := 0. 

runningHash := (first goodHash + runningHash) timesRandomMultiplier. 
runningHash := (last goodHash + runningHash) timesRandomMultiplier. 
runningHash := (middle goodHash + runningHash) timesRandomMultiplier. 
runningHash := (prefix goodHash + runningHash) timesRandomMultiplier. 
runningHash := (generation goodHash + runningHash) timesRandomMultiplier. 
runningHash := (designation goodHash + runningHash) timesRandomMultiplier. 
A runningHash bitXor: 16r05E7054E! 
hasSameUniquenessKeysAs: other 
"*** Generated method ***" 

other = self ifTrue: [ A true]. 

other ooClass == self ooClass ifFalse: [ A false]. 

A true! 



!Telecom_Name methodsFor: 'Generated - initialization'! 
initializeName 

"*** Generated method ***" 

first := 
last := 
middle := 
prefix := '*. 
generation := ". 
designation := ".! 

i 



!Telecom_Name methodsFor: 'Generated - accessing'! 
last 

"*♦* Generated method ***" 

last assertTypeOrNil: String. 
A last! 
last: aString 

"*** Generated method ***" 

aString assertTypeOrNil: Strip, 
last := aString. f£ - 

self changed: #last.! ^ ■ "- 
middle 

"*** Generated method ***" 

middle assertTypeOrNil: String. 
A middle! 
middle: aString 

***** Generated method ♦**" 

aString assertTypeOrNil: String, 
middle :- aString. 
self changed: #middle.! 
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prefix 

"*** Generated method ***" 

prefix assertTypeOrNil: String, 
"prefix! 
prefix: aString 

H *** Generated method ***" 

aString assertTypeOrNil: String, 
prefix := aString. 
self changed: #prefix.! 



Smalltalk defineClass: #Telecorn_Payment 
superclass: #{Core.Object} 
indexedType: #none 
private: false 
instanceVariableNames: ' 

amount <uint32> 

date <uint64>' 
classInstanceVariableNames: " 
imports: " 

category: 'Generated Code - Applications.GeneratedCodeApp'! 

!Telecom_Payment class methodsFor: 'Generated - instance creation*! 
new 

"*** Generated method ***" 
A super new initializePayment! 



!Telecom_Payment class methodsFor: 'private: generated'! 
ooCodeGenVersion 

A 1! 

ooTypedlnstanceVariablesString 

A ' 

amount <uint32> 
date <uint64>'! 

t 



!Telecom_Payment methodsFor: 'Generated - comparing'! 
= other 

"*** Generated method ***" 

other — self ifTrue: [ A true]. 

other ooClass == self ooClass ifFalse: [ A false]. 

self date - other date ifFalse: [ A false]. 

self amount = other amount ifFalse: [ A false]. 

A true! 



!Telecom_Payment methodsFor '"Generated • accessing'! 
amount J.f _ 

"*** Generated method ; . 

amount assertTypeOrNil: Integer. 
A amount! 
amount: anlnteger 

"*** Generated method ***" 

anlnteger assertTypeOrNil: Integer, 
amount := anlnteger. 
self changed: #amounU 

t 
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!Telecom_Payment methodsFor: 'Generated - assignment'! 
assignFrom: other 

"*** Generated method ***** 

other = self ifTrue: [ A self|. 

[other ooClass = self ooClass] assert. 

self date: other date. 

self amount: other amount.! 



!Telecom_Payment methodsFor: 'Generated - accessing'! 
clearAmount 

"*** Generated method ***" 

amount := 16rFFFFFFFF. 
self changed: #amount! 
clearDate 

"*** Generated method ***" 

date := 0. 

self changed: #date.! 



!Telecom_Payment methodsFor: 'Generated - clustering'! 
clusterWith: anObjectToClusterWith 
"*** Generated method ***" 

anObjectToClusterWith mioCluster: self.! 



!Te1ecom_Payment methodsFor: 'Generated - accessing*! 
date 

-•** Generated method ***** 

(Timestamp fromMilliseconds: date) assertTypeOrNil: Timestamp. 
A (Timestamp fromMilliseconds: date)! 
date: aTimestamp 

"*** Generated method ***" 



aTimestamp assertTypeOrNil: Timestamp. 
date := aTimestamp asMilliseconds. 
self changed: #date.! 



!Telecom_Payment methodsFor: 'Generated - deletion'! 
delete 

"*** Generated method ***" 

self oolsPersistent ifFalse: [ A self]. 
selfooDelete.! 

t 



!Telecom_Payment memodsFor. : *jeiierated - comparing'! 
hash 

M *** Generated method ***" 

| runningHash | 
runningHash := 0. 

runningHash := (date goodHash + runningHash) timesRandomMultiplier. 
runningHash := (amount goodHash + runningHash) timesRandomMultiplier. 
A runningHash bitXor: 16r05E7054E! 
hasSameUniquenessKeysAs: other 
"*** Generated method ***" 

other = self ifTrue: [ A true]. 

other ooClass = self ooClass ifFalse: [ A false]. 

A true! 
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!Telecom_Payment methodsFor: 'Generated - initialization'! 
initializePayment 

"*** Generated method 



date := 0. 

amount := 16rFFFFFFFF.! 



Smalltalk defineClass: #Telecom_Person 

superclass: #{Core.Object} 

indexedType: #none 

private: false 

instanceVariableNames: 1 

changeNode <ChangeNode> 

indexingState <uint8> . 

remote Index En tries <ooVArray(IndexEntry)> 

locallndexEntries <ooVArray(ooShortRef(IndexEntry))> 

accounts <ooVArray(Telecom_Account)> 

addresses <ooVArray(ooShortRef(Telecom_Address))> 

birthDate <uint32> 

contactEvents <ooVArray(Telecom_ContactEvent)> 

email <ooVString> 

name <ooShortRef(Telecom_Name)> 

ssn <uint32>' 
classInstanceVariableNames: " 
imports: ". 

category: 'Generated Code - Applications. GeneratedCodeApp'! 

!Telecom_Person class methodsFor: 'Generated - instance creation'! 
new 

Generated method ***" 
A super new initialize Person! 



!Telecom_Person class methodsFor: 'private: generated'! 
ooCodeGenVersion 

* 1! 

ooTypedlnstanceVariablesString 



changeNode <ChangeNode> 
indexingState <uint8> 

remotelndexEntries <ooVArray(IndexEntry)> 
locallndexEntries <ooVArray(ooShortRefl(IndexEntry))> 
accounts <ooVArray(Telecom_Account)> 
addresses <ooVArray(ooShortRef(Telecom_Address))> 
birthDate <uint32> 

contactEvents <ooVArray(Telecom__ContactEvent)> 
email <ooVString> 
name <ooShortRef(Telecom_Name)> 
ssn <uint32>'! 



!Telecom_Person methodsFor: tk&Srated - comparing*! 
= other 

Generated method 

other == self ifTrue: [ A true]. 

other ooClass = self ooClass ifFalse: [ A false]. 

self birthDate = other birthDate ifFalse: [ A false]. 

self email = other email ifFalse: [ A false], 

self ssn = other ssn ifFalse: [ A false]. 

self addresses = other addresses ifFalse: [ A false]. 

self name - other name ifFalse: [ A false]. 

self contactEvents = other contactEvents ifFalse: [ A false]. 

self accounts = other accounts ifFalse: [ A false]. 

A true! 



A < 
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!Telecom_Person methodsFor: 'Generated - accessing'! 
accounts 

"*** Generated method ***" 



"accounts assertAllType: Telecom_Account." 
^accounts! 
accounts: someAccounts 
"*** Generated method 

"someAccounts assertAllType: Telecom_Account." 
accounts replaceWithElements: someAccounts. 
self ooUpdate. 
self changed: #accounts.! 
addAccount: anAccount 

"*** Generated method **♦" 

"anAccount assertType: Telecom_Account." 
accounts addElement: anAccount. 
self ooUpdate. 
self changed: #accounts.! 
addAddress: anAddress 

"*** Generated method **•" . 

"anAddress assertType: Telecom_Address." 
addresses addElement: anAddress. 
self ooUpdate. 
self changed: #addresses.! 
addContactEvent: aContactEvent 
Generated method ***" 

"aContactEvent assertType: Telecom_ContactEvent. 
contactEvents addElement: aContactEvent. 
self ooUpdate. 

self changed: #contactEvents.! 
addresses 

"*** Generated method ***" 

"addresses assertAllType: Telecom_Address." 
A addresses! 
addresses: someAddresses 

"*** Generated method ***" 

"someAddresses assertAllType: Telecom_Address." 
addresses replaceWithElements: someAddresses. 
self ooUpdate. 
self changed: #addresses.! 

! 



!Telecom_Person methodsFor: 'Generated - assignment'! 
assignFrom: other 

"*** Generated method 

other — self ifTrue: [^elf]. 

[other ooClass == self ooClass] assert 

selfbirthDate: other birthDsJfe^ 

self email: other email. ^p- 

self ssn: other ssn. JJn 

self addresses = other addr&ertfFalse: [ 

self addresses do: [:x f x delete]. 

self addresses: other addresses], 
self name ooClass — otheT name ooClass 

ifTrue: [self name assignFrom: other name] 

ifFalse: [ 

self name delete, 
self name: other name], 
self contactEvents: other contactEvents. 
self accounts: other accounts.! 

i 



!Telecom_Person methodsFor: 'Generated - index entries'! 
be Deleting 

"*** Generated method ***" 

[self isStable] assert. 

self setlndexingState: (indexingState bitOr: 1).! 
beReindexing 

"*** Generated method *** M 

[self isStable] assert. 

self setlndexingState: (indexingState bitOr: 2).! 
beStable 

"*** Generated method ***" 

[self isStable not] assert. 

self setlndexingState: (indexingState bitAnd: 3 bitlnvert).! 



!Telecom_Person methodsFor: 'Generated - accessing'! 
birthDate 

"*** Generated method ***" 

(Date fromYYYYMMDDInteger: birthDate) assertTypeOrNil: Date. 
A (Date fromYYYYMMDDInteger: birthDate)! 
birthDate. aDate 

M * * * Generated method * * * " 

aDate assertTypeOrNil: Date. 
birthDate := aDate asYYYYM MDDInteger. 
self changed: #birthDate.! 
changeNode 

"*** Generated method ***" 

A changeNode! 
changeNode: aChangeNode 
"*** Generated method 

changeNode := aChangeNode.! 
clearAccounts 

Generated method 

accounts do: [:x | x delete], 
accounts replaceWithElements: #()• 
self ooUpdate. 
self changed: #accounts.! 
clearAddresses 

" * * * Generated method * * ♦ " 

addresses do: [:x | x delete], 
addresses replaceWithElements: #(). 
self ooUpdate. 
self changed: #addresses.! 
clearBirthDate 

Generated method 

birthDate := 0. 
self changed: #birthDatc.! 
clearContactEvents 

"*** Generated method 

contactEvents do: [:x | x delete]. 
contactEvents replaceWithElements: #(). 
self ooUpdate. 

self changed: #contactEvents.! 
clearEmail 

Generated method ***" 
email := ". 

self changed: #email.! 
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clearName 

"*** Generated method ♦♦*" 

name delete, 
name nil. 
self changed: #name.! 



!Telecom_Person methodsFor: 'Generated - index entries'! 
clearRequests 

"*♦♦ Generated method ***" 

self setlndexingState: (indexingState bitAnd: 12 bitlnvert).! 



!Telecom_Person methodsFor: 'Generated - accessing'! 
clearSsn 

"*** Generated method***" 

ssn := 16rFFFFFFFF, 
self changed: #ssn.! 



!Telecom_Person methodsFor: 'Generated - clustering'! 
clusterWith: anObjectToClusterWith 
"*** Generated method ***" 

anObjectToClusterWith mioCluster: self, 
addresses do: [:x | x clusterWith: self), 
name clusterWith: self. 
contactEvents do: [:x | x clusterWith: self], 
accounts do: [:x | x clusterWith: self].! 



!Telecom_Person methodsFor: 'Generated - accessing'! 
contactEvents 

"*** Generated method ***" 

"contactEvents assertAilType: Telecom_ContactEvent." 
A contactEvents! 
contactEvents: someContactE vents 
. "*** Generated method ***" 

"someContactEvents assertAilType: Telecom__ContactEvent." 
contactEvents replaceWithElements: someContactEvents. 
self ooUpdate. 

self changed: #contactEvents.! 



!Telecom_Person methodsFor: 'Generated - deletion'! 
delete 

"*** Generated method ***" 

self oolsPersistent iffalsc: ffjjdfl* 
addresses do: [:x | x delete]^; 
name delete. : ' f ' ?pr ' 

local IndexEn tries do: [:ic \ ic delete]. 
selfooDelete.! 
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!Te!ecom_Person methodsFor: 'Generated - accessing'! 
email 

"*** Generated method ♦**" 

email assertTypeOrNil: String. 
A email! 
email: aString 

"*** Generated method ***" 

aString assertTypeOrNil: String, 
email := aString. 
self changed: #email.! 



!Te1ecom_Person methodsFor: 'Generated - comparing'! 
hash 

"*** Generated method 

| runningHash | 
runningHash :- 0. 

runningHash := (birthDate goodHash + runningHash) timesRandomMultiplier. 

runningHash (email goodHash + runningHash) timesRandomMultiplier. 

runningHash := (ssn goodHash + runningHash) timesRandomMultiplier. 

runningHash := ((addresses sum: [:x | x goodHash]) + runningHash) timesRandomMultiplier. 

runningHash := (name goodHash + runningHash) timesRandomMultiplier. 

runningHash := ((contactEvents sum: [:x | x goodHash]) + runningHash) timesRandomMultiplier. 

runningHash := ((accounts sum: [:x | x goodHash]) + runningHash) timesRandomMultiplier. 

A runningHash bitXor: 16rO5E7054E! 



!Telecom_Person methodsFor: 'Generated - index entries'! 
has Requested Deletion 

w *** Generated method ***" 

A (indexingState bitAnd: 4) — 0! 
has Requested Reindexing 

"*** Generated method ***" 

A (indexingState bitAnd: 8) ~= 0! 



!Telecom_Person methodsFor: 'Generated - comparing'! 
hasSameUniquenessKeysAs: other 
"*** Generated method 

other = self iff rue: [ A true]. 

other ooClass = self ooClass ifFalse: [ A false]. 

A true! 

i 



!Telecom_Person methodsFor: 'Generated - index entries'! 
indexingState ^ 
Generated method ****!^ 

& . 

A indexingState! 
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!TeIecom_Person methodsFor: 'Generated - initialization 1 ! 
initializePerson 

Generated method ***" 

indexingState := 0. 

remote Index Entries := OoVArray new. 
local Index En tries := OoVArray new. 
birthDate := 0. 
email := ". 

ssn := l6rFFFFFFFF. 
addresses := OoVArray new. 
name := Telecorn_Name new. 
contactEvents := OoVArray new. 
accounts OoVArray new.! 



!Telecom_Person methodsFor: 'Generated - index entries'! 
isDeleting 

"*** Generated method 

A (indexingState bitAnd: 1)~=0! 
isReindexing 

"*** Generated method 

A (indexingState bitAnd: 2) ~= 0! 
isStable 

"*•• Generated method 

A (indexingState bitAnd: 3) - 0! 
local IndexEntries 

"*** Generated method 

A localIndexEntries! 
locallndexEntries: somelndexEntries 
Generated method *** n 

somelndexEntries assertAHTypeOrNil: IndexEntry. 
locallndexEntries replaceWith Elements: somelndexEntries. 
self ooUpdate.! 
localOrTransientindexEntries 

"*** Generated method ***" 

self isStable 

ifTrue: [ A self transientlndexEntries] 
ifFalse: [ A self locallndexEntries].! 

i 



!Telecom_Person methodsFor: 'Generated - accessing'! 
name 

Generated method 

name assertTypeOrNil: TelecomJMame. 
A name! 
name: aName 

"*** Generated method 

aName assertTypeOrNil: Tcfeawn.Name. 
name := aName. 
self changed: #name.! 

i 



!Telecom_Person methodsFor: 'Generated - copying*! 
postCopy 

Generated method 
super postCopy. 

addresses := addresses collect: [:x | x copy], 
name := name copy. 
contactEvents := contactEvents copy, 
accounts := accounts copy.! 

i 
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!Telecom_Person methodsFor: 'Generated - index entries'! 
privateSetlndexingState: anlnteger 
"*** Generated method ***" 

"Transcript crtab: 5; nextPutAll: 'indexingState: '; print: indexingState; nextPutAll: ' -> '; print: anlnteger; nextPutAll: 
indexingState := anlnteger.!. 
remotelndexEntries 

"*** Generated method 

RemotelndexEntries ! 
remotelndexEntries: somelndex En tries 
Generated method 

"somelndexEntries assertAllTypeOrNil: IndexEntry." "Too expensive to check" 
remotelndexEntries replaceWithElements: somelndexEntries. 
self ooUpdate.! 



!Te1ecom_Person methodsFor: 'Generated - accessing'! 
removeAccount: anAccount 

"*** Generated method ***" 

"anAccount assertType: Telecom_Account." 
accounts remove Element: anAccount. 
self ooUpdate. 
self changed: #accounts.! 
remove Address: anAddress 

"*** Generated method ***" 

"anAddress assertType: Telecom_Address." 
addresses removeElement: anAddress. 
self ooUpdate. 
self changed: #addresses.! 
removeContactEvent: aContactEvent 
"*** Generated method ***" 

"aContactEvent assertType: Telecom_ContactEvent." 
contactEvents removeElement: aContactEvent. 
self ooUpdate. 

self changed: #contactEvents.! 



!Telecom_Person methodsFor: 'Generated - index entries'! 
requestDeletion 

Generated method 

[self isStable not] assert, 
self setlndexingState: (indexingState bitOr: 4).! 
requestReindexing 

Generated method 

[self isStable not] assert, 
self setlndexingState: (indexingState bitOr: 8).! 
setlndexingState: anlnteger 

Generated method ** < £S 

indexingState = anlnteger ifl&te [self privateSetlndexingState: anlnteger]. ! 



!Telecom_Person methodsFor: 'Generated - accessing'! 
ssn 

"•** Generated method 

ssn assertTypeOrNil: Integer. 
A ssn! 
ssn: anlnteger 

"*♦* Generated method ***" 

anlnteger assertTypeOrNil: Integer, 
ssn ~ anlnteger. 
self changed: #ssn.l 
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!Telecom_Person methodsFor: 'Generated - index entries'! 
trans ientlndex Entries 

•'♦** Generated method •**" 

| transient Index Entries | 

transientlndexEntries := OrderedCollection new. 
A transientlndexEntries.asArray! 



Smalltalk.Applications defineClass: #GeneratedCodeApp 
superclass: #{ ENVY. Application} 
indexedType: #none 
private: false 

instance VariableNames: M 
classInstanceVariableNames: " 
imports: " 

category: 'ENVY/Manager'! 



!Applications.GeneratedCodeApp class methodsFor: 'EM-lntemal'! 
_PRAGMA_ 

"Smalltalk 

defineNameSpace: #Test 
private: false 

imports: 'private Smalltalk.*' 

category: 'Generated Code - Applications.GeneratedCodeApp')" 
"Smalltalk( 

defineNameSpace: #Telecom 
private: false 

imports: 'private Smalltalk.*' 

category: 'Generated Code - Applications.GeneratedCodeApp')" 
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Smalltalk defineClass: #Activator 
superclass: #{Core.Object} 
indexedTypc: #none 
private: false 

instanceVariableNames: 'bytes byteslndex classes objects translation classFixups ' 
classlnstanceVariableNames: M 
imports: " 
category: "! 

lActivator class methodsFor: "private-recognition'! 
class Recognizes: aStream 

"Test if the stream's format is recognizeable by this class." 

| savedPosition header | 
savedPosition := aStream position, 
header := self headerString asByteArray. 
1 to: header size do: [:index | 

(aStream atEnd or: [aStream next ~= (header at: index)]) ifTrue: [ 

aStream position: savedPosition. 

A false]]. 

aStream position: savedPosition. 
A true! 



lActivator class methodsFor: 'conversion'! 

convert: byteArray 

"Answer an object representing the activation of the given byteArray. See 
Passivator class»whatIsTheFiIeFormat for more details." 

| whichClass byteStream | 

byteArray assertType: ByteArray. 

byteStream := byteArray readStream. 

whichClass := self withAHSubclasses 

detect: [:class | class class Recognizes: byteStream] 

ifNone: [self error: 'Unsupported Activator/Passivator format*]. 

A whichClass new convert: byteArray! 



!Activator class methodsFor: 'private-recognition'! 
headerString 

"Answer the prefix used to identify this format." 

A 'Passivator_VW1.2M 



lActivator class methodsFor: 'conversion'! 
recognizes: aStream 

"Test if the stream's format is recognizeable by myself. 

Always restores the stream's position to what it was when 

the method was called." 

(self classRecognizes: aStream) ifTrue: [ A true]. 

A self subclasses any: [:subclass | subclass recognizes: aStream]! 



lActivator methodsFor: private-activation'! 
activateObjects 

"Ask each object to do its activation translation. Activate the objects in 
bottom-up order (in the absence of relevant cycles) to simplify user fixup 
code. The Passivator had the responsibility of writing the objects in 
reverse-bottom-up order to satisfy this constraint." 

translation := Identity Dictionary new: objects size, 
objects size to: 1 by: -1 do: [:index | 

| before after | 

before := objects at: index. 

self translateFieldsOf: before. 

"Ok, the fields have been translated. Now activate the current one..." 

after := before postLoad Activation: self. 

before = after ifFalse: [translation at: before put: after]].! 

i 
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! Activator methodsFor: 'private -con verting'! 
convert: byteArray 

"Answer anObject created from the description in byteArray." 



| header root | 

byteArray assertType: ByteArray. 
bytes :- byteArray. 
byteslndex :- 0. 

header := self class headerString. 

(bytes copyFrom: 1 to: header size) asString = header ifFalse: [self error: 'Invalid header encountered'], 
byteslndex := byteslndex + header size, 
self readClasses. 
self readObjects. 

root := self objectFromlndex: self read Int. 

byteslndex = bytes size ifFalse: [self error: 'Expected end of data*]. 

self activateObjects. 

"translation at: root ifAbsent: [root].! 



!Activator methodsFor: 'private-encoding'! 
objectFromlndex: index 

"Answer a non-negative integer representing anObject in the current scheme. 

See Passivator class»whatIsTheFileFormat and Passivator»indexOfObject: 

for more details." 

| mod4 1 

mod4 := index \\4. 
mod4 = 0 ifTrue: [ 

index = 0 ifTrue: [ A nil]. 

index = 4 ifTrue: [ A true]. 

index = 8 ifTrue: [ A false]. 

"Character value: (index - 12 bitShift: -2)]. 
mod4 = 1 ifTrue: [ 

index \\ 8 = 1 

ifTrue: [ A l - index bitShift: -3] 
ifFalse: [ A index - 5 bitShift: -3]]. 
mod4 = 2 ifTrue: [ A classes at: (index - 2 bitShift: -2) + 1 ]. 
"[mod4 = 3] assert." 
-objects at: (index "- 3" bitShift: -2) + 1 ! 
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lActivator methodsFor: 'private -reading'! 
readC lasses 

A selfreadClassesStartingAt: 1! 
readClassesStartingAt: firstClasslndex 

| howMany oldClasses classlndex | 
howMany := self readlnt. 

oldClasses := classes isNil ifTrue: [#()] ifFalse: [classes], 
classes := Array new: howMany. 

classes replaceFrom: 1 to: oldClasses size with: oldClasses startingAt: I . 
classFixups isNil ifTrue: [ 

classFixups := IdentityDictionary new: howMany * 2]. 
classlndex := firstClasslndex. 
[classlndex <= howMany] whileTrue: [ 

| name class format filelnstVars imagelnstVars stream | 

name :- self readSizedString. 

(name includes: Character space) 
ifTrue: [ 

"It's a metaclass" 

(name readStream upTo: Character space; upToEnd) - 'class* ifFalse: [ 

self error: 'expected metaclass name'], 
class ~ (name readStream upTo: Character space) asQualifiedReference value class] 
ifFalse: [ 

"It's a class" 

class := name asQualifiedReference value], 
classes at: classlndex put: class, 
format :- self readlnt. 

stream := ReadStream on: self readSizedString. 
filelnstVars := OrderedCollection new: 20. 

[stream atEnd] whileFalse: [filelnstVars addLast: (stream upTo: $ )]. 
imagelnstVars class alllnstVarNames. 

(format ~= class format or: [filelnstVars — • imagelnstVars]) ifTrue: [ 
classFixups at: class put: (class 

activatorFixupForFormat: format 
instVars: filelnstVars 

isVariable: (format bitAnd: Object indexableMask) ~= 0 
isBits: (format bitAnd: Object pointersMask) ~= Object pointersMask)]. 
classlndex := classlndex + 1 . 

]•! 

readlnt 

"Read a non-negative integer from the stream. See Passivator class»whatIsFileFormat." 
" I byte | 

byte := bytes at: (byteslndex := byteslndex + 1). 

byte <= 127 ifTrue: [ A byte]. 

A (self readlnt bitShift: 7) + (byte bitAnd: 1 27) " 

1 low high | 

low ™ bytes at: (byteslndex := byteslndex +1). 
low.<= 127 ifTrue: [ A low]. 
high := bytes at: (byteslndex := byteslndex +1). 
high<= 127 

ifTrue: [ A (high bitShift: 7) + low - 128] 

ifFalse: [ A (self readlnt bitShift: 14) + (high bitShift: 7) + low - 16512 "128*128+128"]! 
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readObjects 



| howMany class object | 
howMany := self readlnt. 

"First pass: Just create the empty (appropriately-sized) objects..." 
objects :- Array new: howMany. 
I to: howMany do: [:i | 

class := classes at: 1 + self readlnt. 
objects at: i put: (class isVariable 

ifTrue: [class basicNew: self readlnt] 
ifFalse: [class basicNew])]. 

"Second pass: Read object contents, setting object references and byte data..." 
1 to: howMany do: [:objectlndex | 
| fixup | 

object :- objects at: objectlndex. 
fixup := classFixups at: object class ifAbsent: [nil], 
fixup isNil 
ifTrue: [ 

1 to: object class instSize do: [:i | 

object instVarAt: i put: (self objectFromlndex: self readlnt)]. 
object class isVariable ifTrue: [ 
object class isBits 

ifTrue: [self readRawByteslnto: object] 
ifFalse: [ 

1 to: object basicSize do: [:i | 

object basic At: i put: (self objectFromlndex: self readlnt)]]]] 

ifFalse: [ 

fixup value: object value: self]] ! 
readRawByteslnto: anObject 

"Fill an object's byte-indexable fields from the stream." 

anObject class isBits ifFalse: [self error: 'Clasps kind is wrong']. 
1 to: anObject basicSize do: [:i | 

anObject basicAt: i put: (bytes at: (byteslndex := byteslndex + 1))].! 
readSizedString 

"Read a string preceded by its size." 

| size str | 

size := self readlnt. 

str := bytes copyFrom: byteslndex + 1 to: (byteslndex := byteslndex + size). 
A str asString! 



lActivator methodsFor: 'private-activation*! 
translateFieldsOf: anObject 

"Translate the fields of the object, based on current available translations." 

| class | 

translation size - 0 ifTrue: [ A self|. "Short circuit if no mappings have occurred yet" 
class := anObject class. 
1 to: class instSize do: [:i | 
| field | 

field := anObject instVarAt: i. 
(translation includesKey: field) ifTrue: [ 

anObject instV»jLfc i put: (translation at: field ifAbsent: [nil error: 'Invalid translation table'])]], 
(class isVariable and: [cla^^jomters]) ifTrue: [ 
I to: anObject basiciwjdfc :[:i | 
I field) air- 
field := anObject basicAt: i. 
(translation includesKey: field) ifTrue: [ 

anObject basicAt: i put: (translation at: field ifAbsent: [nil error: 'Invalid translation table'])]]]. 



Smalltalk defineClass: #ContinuousActivator 
superclass: # {Activator} 
indexedType: #none 
private: false 
instance VariableNames: " 
classInstanceVariableNames: " 
imports: " 
category: "! 
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!ContinuousActivator class methodsFor: 'accessing'! 
headerString 

"Answer the prefix used to identify this format." 

A, CP5i'! 



!ContinuousActivator methodsFor: 'private-converting'! 
convert: byteArray 

"Answer anObject created from the description in byteArray." 

| result | 

result := super convert: byteArray. 

objects := bytes := translation := nil. "Save some memory" 

Result! 



! Continuous Activator methodsFor: 'private-reading'! 
readClasses 

A self readCIassesStartingAt: (classes isNil iffrue: [1] ifFalse: [classes size+ 1])! 



Smalltalk defineCiass: #MiosoftActivator 
superclass: # {ContinuousActivator} 
indexedType: #none 
private: false 

instance VariableNames: 'session ' 
classInstanceVariableNames: " 
imports: " 
category: "! 

JMiosoftActivator class methodsFor: 'accessing'! 
headerString 

"Answer the prefix used to identify this format." 

A, M' "MisforMiosoft."! 



!MiosoftActivator methodsFor: 'accessing'! 
session 

A session! 
session: anOoSession 

session :- anOoSession.! 

t 

Smalltalk detlneCiass: # Pa^i^ a€io nlLa r seld en tti i> icrttio n a r-y 
superclass: #{Core.Collection} 
indexedType: #none 
private: false 

instance VariableNames: f bygategory * 
classInstanceVariableNam^^^. 
imports: " 
category: "! 

!PassivationLargeldentityDictionary class methodsFor: 'instance creation*! 
new 

A super new initialize! 

! 
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! Passivation Largeldentity Dictionary methodsFor: 'As yet unclassified'! 
at: key 

"Look up the object at key." 
| map | 

map := byCategory at: (self primaryCategorizationOf: key). 
A map at: key! 
at: key ifAbsent: aBIock 

"Look up the object at key. If unknown, answer aBlock's value." 

| map | 

map := byCategory at: (self primaryCategorizationOf: key) ifAbsent: [nil], 
map isNil ifTrue: [ A aBlock value]. 
A map at: key ifAbsent: aBIock! 
at: key ifAbsentPut: aBIock 

"Look up the object at key. If unknown, store aBlock's value under that key and answer that value." 

| map | 

map byCategory at: (self primaryCategorizationOf: key) ifAbsentPut: [IdentityDictionary new]. 
A map at: key ifAbsentPut: aBIock! 
at: key put: value 

"Store value at key." 

| category map | 

category := self primaryCategorizationOf: key. 

map := byCategory at: category ifAbsent: [byCategory at: category put: IdentityDictionary new]. 
A map at: key put: value! 
do: aBIock 

"Execute aBIock with each value." 

byCategory do: [:map | 
map do: aBIock].! 
includesKey: key 

"Look up the key. Answer whether a value was found." 

| map | 

map := byCategory at: (self primaryCategorizationOf: key) ifAbsent: [ A false]. 
A map includesKey: key! 
initialize 

byCategory .:= IdentityDictionary new: 20.! 
keysAndValuesDo: twoArgBlock 

"Execute twoArgBlock with each key and value." 

byCategory do: [:map | 

map keysAndValuesDo: twoArgBlock].! 
keysDo: aBIock 

"Execute aBIock with each key." 

byCategory do: [:map | 

map keysDo: aBIock].! 
primaryCategorizationOf: anObject 

"Answer something permanent about the object, besides its identity hash, on which to initially segregate 
objects (to supplement the pathologically bad 14-bit identity hashing Visual Works forces." 

A anObject oolsPersistent . 

ifTrue: [anObject oid j^MncrNumber] 
ifFalse: [anObject cla|p.*: 



size 




s := 0. 

byCategory do: [:map | s := s + map size]. 
A s! 



145 



Smalltalk defineClass: #PrivatePassivationByteArray 

superclass: #{Core.Byte Array} 
indexedType: #bytes 
private: false 

instance VariableNames: " 
cl assistance VariableNames: " 
imports: " 
category: "! 



IPrivatePassivationByte Array methodsFor: 'accessing'! 

at: index put: byteValue 

"Store the argument value in the indexable field of the receiver 
indicated by index. Fail if the index is not a Smalllnteger or 
is out of bounds, or if the byteValue is not a Smalllnteger 
between 0 and 255. Answer the value that was stored. If the 
store is beyond the end of the receiver, grow it to make room, 
and a linear amount of excess, to offset the cost of copying 
the data. This keeps amortized growth cost linear." 

<primitive: 42 1> 

index > self size ifTrue: [self growTo: index * 4 + 1000]. 
A super at: index put: byteValue! 
growTo: newSize 

"Grow the receiver to the given new size. Do a become: to enlarge it in place. 
Answer nil." 

|newMe| 
. newMe := self class new: newSize. 

newMe replaceBytesFrom: 1 to: self size with: self startingAt: 1. 
newMe become: self. 

"Answer nil to avoid receiver interpretation problems." 
A nil! 

replaceBytesFrom: start to: stop with: replacement startingAt: repStart 

"This destructively replaces elements from start to stop in the receiver 
starting at index, repStart, in the collection, replacement. Answer the 
receiver. If the transfer is beyond the end of the receiver, grow it to 
make room, and a linear amount of excess, to offset the cost of copying 
the data. This keeps amortized growth cost linear." 

<primitive: 559> 

stop > self size ifTrue: [self growTo: stop * 4 + 1000]. 

A super replaceBytesFrom: start to: stop with: replacement startingAt: repStart! 



Smalltalk defineClass: #PassivatedPersistentObjectReference 

superclass: #{Core.Object} 
indexedType: #bytes 
private: false 

instanceVariableNames: " 
classlnstance VariableNames: " 
imports: " 
category: "! 

IPassivatedPersistentObjectReference class methodsFor: 'instance creation'! 
new 

"super new: 8! 

t 
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IPassivatedPersistentObjectReference methodsFor: 'accessing'! 
oid: anOid 



| con obj | 

con := anOid containerNumber. 

self basic At: 1 put: (con bitShift: -24). 

self basicAt: 2 put: ((con bitShift: -16) bitAnd: 255). 

self basicAt: 3 put: ((con bitShift: -8) bitAnd: 255). 

self basicAt: 4 put: (con bitAnd: 255). 

obj := anOid objectNumber. 

self basicAt: 5 put: (obj bitShift: -24). 

self basicAt: 6 put: ((obj bitShift: -16) bitAnd: 255). 

self basicAt: 7 put: ((obj bitShift: -8) bitAnd: 255). 

self basicAt: 8 put: (obj bitAnd: 255).! 



IPassivatedPersistentObjectReference methodsFor: 'passivation/activation'! 

postLoad Activation: anActivator 

"Activate myself now that I have been loaded by anActivator. Answer the object 
to substitute for myself in parent objects (when not involved in cycles)." 

| con obj container object | 

anActivator assertType: MiosoftActivator. 

anActivator session assertType: OoSession. 



con := (self basicAt: 4) 

+ ((self basicAt: 3) bitShift: 8) 

+ ((self basicAt: 2) bitShift: 1 6) 

+ ((self basicAt: 1) bitShift: 24). 
obj := (self basicAt: 8) 

+ ((self basicAt: 7) bitShift: 8) 

+ ((self basicAt: 6) bitShift: 16) 

+ ((self basicAt: 5) bitShift: 24). 

container := anActivator session ooProvideContainerFor: con with: obj. 

object := container ooProvideObject: obj. 

A object! 



Small talk defineClass: ^Passivation Representative 
superclass: #{Core.Object} 
indexedType: #none 
private: false 

instance VariableNames: 'object index parentCount subrepresentatives ' 
classInstanceVariableNames: " 
imports: " 
category: "! 



! Passivation Representative methodsFor: 'scanning'! 
creates ubrepresentativesln: passivator 

| els isVar subscript | 

els :- object class. &tjj££ 

isVar := els isVariable and: fcls isPointers]. 

subrepresentatives ~ AnayStfcw: els instSize + (isVar ifTrue: [object basicSize] ifFalse: [0]). 
1 to: els instSize do: [:i | 
subrepresentatives 
at: i 

put: (passivator incrementingRepresentativeFor: (object instVarAt: i))]. 
isVar ifTrue: [ 

subscript := els instSize. 
1 to: object basicSize do: [:i | 
subrepresentatives 

at: (subscript := subscript + 1 ) 

put: (passivator incrementingRepresentativeFor: (object basicAt: i))]].! 
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! Passivation Representative methodsFor: 'private-accessing'! 
decrementParentCount 

"Answers the resulting count." 

A parentCount := parentCount - 1 ! 
incrementParentCount 

parentCount :- parentCount + 1 .! 

index 

A index! 
index: anlnteger 

index := anlnteger.! 
object 

A object! 
object: anObject 

[anObject notNil] assert." 
object := anObject.! 
parentCount 

^parentCount! 
parentCount: anlnteger 

parentCount := anlnteger! 



!PassivationRepresentative methodsFor: 'private-writing'! 
passivationlntegerEncodingln: aPassivator 

A index * 4 + 3! 



IPassivationRepresentative methodsFor: 'private-accessing'! 
subrepresentatives 

A subrepresentatives ! 

i 



IPassivationRepresentative methodsFor: 'private-writing'! 
writePartlFor: passivator 

"Write the first half of my local data. I always write my class's id and my 

basicSize (if variable) in the first pass so the object shells can be constructed 

at load time." 

passivator writelnt: (passivator indexOfClass: object class), 
object class is Variable ifTrue: [ 

passivator writelnt: object basicSize].! 
writePart2For: passivator 

"Write the final half of my local data. See writePartlFor:. I always write my named 
instance variables, then eacHM my indexed (pointer) instance variables (if any)." 

1 to: subrepresentatives size?<k>: [H | 

passivator writeReferen^oRepresentative: (subrepresentatives at: i)]. 
object class isBits iff rue: [ 

"Write out the object's bytes." 

passivator write RawBytes: object].! 

I 

Smalltalk defineClass: #Passivator 
superclass: #{Core.Object} 
indexedType: #none 
private: false 

instance VariableNames: *bytes byteslndex objectTo Representative allRepresentatives stream root classesToIndex stack ' 
classlnstanceVariableNames: " 
imports: " 
category: "! 
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! Pass ivator class methodsFor: 'instance creation*! 
convert: anObject 

"Answer a ByteArray representing the passivation of anObject. For example, 
'Passivator convert: (l/2@3 comer: 4@5)'. To turn this ByteArray into a copy 
of anObject, run 'Activator convert: aByteArray'." 

A self new convert: anObject! 



! Passivator class methodsFor: 'accessing'! 
headerString 

"Answer the prefix used to identify this format." 

A 'Passivator_VW1.2*» 



! Passivator class methodsFor: 'documentation'! 
whatlsTheFileFormat 

Ints (positive integers often representing something else) are written low-to-high, 7 bits at a time. A byte in the range 128. .255 indicates there is more data following, 
and that the low seven bits contribute to the int being formed. A byte in the range 0..127 is the int itself. For example, the stream 130,99,... is parsed as: Read byte 
(130). It's > 127 so read an int from what's left, multiply by 128, and add 130-128. The recursive read-what's-left sees 99, notes it's <= 127, and simply returns it. The 
end result is 99*128+2 = 12674. 

The file has a header of 'MvG_Passivator\ then two sections: the class section and the object section. The class section starts with an int giving the number of class 
definitions to follow, then a sequence of class definitions of the form: 

(int) size of string to follow 

string containing class name 

(int) class's format integer 

(int) size of string to follow 

string containing instVarNames 

The object section starts with an integer giving the number of objects structures to follow, then a sequence of object structures. In the object structures are references 
(denoted refs) to arbitrary objects, described further below in this comment. The structures are each of the form: 
(int) class index 
if object class is Variable then 

(int) object basicSize 
for i=l to object class instSize 
(ref) object instVarAt: i 
if object class isBits then 

(bytes) raw object contents as a series of bytes 

else 

for i=l to object basicSize 
(ref) object basicAt: i 

The object section has one more thing in it; one ref indicating which object this file represents (usually object #1 , but not for primitive objects). 

All references (refs) to objects are first converted through the following transformation to get an int (which is written in place of the ref)- 
nil -> 0 
true -> 4 
false -> 8 

aCharacter ->4n+12, (where n = aCharacter aslnteger) 

aPositivelnteger -> 8n+5 

aNegativelnteger -> -8n+l 

aBehavior -> 4n+2, (whereo « the class's index) 

anObject -> 4n+3 (where i« the object's index) 



self error: 'Documentation only'.! 

i 
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IPassivator methodsFor: 'private-passes'! 
collectCl asses 

"Figure out which classes need to be included in the output." 

1 to: all Representatives size do: [:i | 
| class | 

class := (allRepresentatives at: i) object class. 
(classesToIndex includesKey: class) ifFalse: [ 

classesToIndex at: class put: classesToIndex size]].! 

collectObjects 

stack := OrderedCol lection new: 100. 
self incrementingRepresentativeFor: root, 
[stack size > 0] whileTrue: [ 

stack removeLast createSubrepresentativesIn: self] ? 



!Passivator methodsFor: 'private -converting'! 
convert: anObject 

"Answer a ByteArray representing the passivation of anObject." 

| result | 

objectTo Representative := PassivationLargeldentityDictionary new. 

allRepresentatives := OrderedCollection new. 

classesToIndex := IdentityDictionary new: 50. 

root anObject 

seif collectObjects. 

self sortObjectsReverseBottomUp. 

self collectClasses. 

bytes := PrivatePassivationByte Array new: (allRepresentatives size * 20 + 50). "guess size" 
byteslndex := 0. "used in a pre-increment way" 
self writeRawBytes: self class headerString. 
' self writeClasses. 
self writeObjects. 

result := ByteArray new: byteslndex. 

result replaceBytesFrom: 1 to: byteslndex with: bytes startingAt: 1. 
Result! 

i 



IPassivator methodsFor: 'private-representation'! 
incrementingRepresentativeFor: anObject 

"Answers a representative for anObject, or anObject itself if it's special. Create a 

representative if necessary, adding it to my stack." 



I rep | 

rep := self representativeFor: anObject. 
rep — anObject ifFalse: [ 

rep parentCount: rep parentCount + 1 ]. 

A rep! 



IPassivator methodsFor: •private-encoding'! 
indexOfClass: aClass 

"Answer the non-negative h&ex of aClass." 

A classesTolndex at: aClass!'-;- ;.. 
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.'Passivator methodsFor: 'private-representation'! 
preSavePassivate: anObject 

A anObject preSavePassivation! 
representative For: anObject 

"Answers a representative for anObject, or anObject itself if it's special. Create 
representative if necessary, adding it to my stack." 

anObject isSpeciallyPassivatedObject ifTrue: [ A anObject]. 
A objectTo Representative 

at: anObject 

ifAbsentPut: [ 
I rep | 

rep := PassivationRepresentative new 
parentCount: 0; 

object: (self preSavePassivate: anObject). 
allRepresentatives addLast: rep. 
stack addLast: rep].! 

r 



151 



IPassivator methodsFor: 'private-passes'! 
sortObjectsReverseBottomUp 

"Sort the objects in reverse bottom-up order (but always with the root first)." 

"This is effectively a treadmill algorithm (a la Henry Baker). It sorts a list in 

place by the topological partial order, automatically breaking cycles when 
necessary. 

Build the list of objects, partitioned by parent count. Keep a separate array 
of partition boundaries. As the single-parent objects are traversed and 
converted to no-parent (and sorted) objects, just fix up each child (make 
sure it occurs after the already-sorted boundary, otherwise we're dealing 
with a victim of a broken cycle." 

| sizes treadmill starts nextSlots toDecrement | 
allRepresentatives size <= 1 ifTrue: [ 

"At most one object requiring touch-ups exists. Don't sort." 

allRepresentatives size = 1 ifTrue: [ 
allRepresentatives first index: 0]. 

*self]. 

(objectToRepresentative at: root) parentCount: 0. "Force root to be in zero-parents partition." 
"First, construct the treadmill with each rep containing its index into it." 
sizes :* OrderedCollection new: 20. 

1 to: allRepresentatives size do: [:i | 

| parentCountPlusOne | 

parentCountPlusOne := (allRepresentatives at: i) parentCount + 1. 
[parentCountPlusOne > sizes size] whileTrue: [sizes addLast: 0]. 
sizes at: parentCountPlusOne put: (sizes at: parentCountPlusOne) + 1]. 
treadmill := Array new: sizes sum. 

starts := Array new: sizes size + 2. "convenient boundary condition" 
starts at: 1 put: 1 . 

2 to: starts size - 1 do: [:i | 

starts at: i put: (starts at: i - 1) + (sizes at: i - 1)]. 
starts at: starts size put: (starts at: starts size - 1 ). 
nextSlots := starts copy. 

"We now have valid partition information, we just need to place the elements there." 
1 to: allRepresentatives size do: [:i | 

| rep parentCount ind | 

rep := allRepresentatives at: i. 

parentCount := rep parentCount. 

ind := nextSlots at: parentCount + 1 . 

nextSlots at: parentCount + 1 put: ind + 1 . 

rep index: ind. 

treadmill at: ind put: rep], 
[(starts copyFrom: 2 to: starts size) = (nextSlots copyFrom: 1 to: nextSlots size - 1)] assert." 
[treadmill all: [:x | x = (treadmill at: x index)]] assert." 

[treadmill all: [:x | x index between: (starts at: x parentCount + 1) and: (starts at: x parentCount + 2) - 1 ]] assert." 
"Make sure the root object is first..." 

[(objectToRepresentative at: root) index = \] assert: 'Root object should be only object with no parents'." 

"Here's how to decrement an object's parent count..." 
toDecrement := [:rep | 

"Not a special object or an already-sorted object. Move object to start 

of partition, then advance partition boundary over it" 

| start | 

start := starts at: rep .parentCount + 1 . 
start = rep index ifFaJjpt . 

I temp | s§ |£v 

temp := treadtnij|^sjtort 

treadmill at: sta^^ rep. 

treadmill at: rep index put: temp. 

temp index: rep index. 

rep index: start]. 
"Slide the boundary..." 
starts at: rep parentCount + 1 put: start + 1 . 
"and fix rep's parentCount..." 
rep decrementParentCount]. 

"Ok, our treadmill is ready. Start chugging objects out the left by moving (starts at: 1 ) forward." 
[starts first = starts last] whileFalse: [ 
starts first = (starts at: 2) 
ifTrue: [ 

"We have no more zero-parent objects, so break a cycle. Choose an object 
with as few parents as possible." 
| victimRep | 
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victimRep := treadmill at: starts first. "Not in the zero-refs range, but in first non-empty range thereafter. 
toDecrement value: victimRep] 
ifFalse: [ 

"We have a zero-parent object." 

| candidate subreps | 

candidate := treadmill at: starts first. 

candidate parentCount = 0 ifFalse: [self error: 'Bug in treadmill'), 
candidate parentCount: nil. 
starts at: 1 put: starts first + 1 . 
subreps := candidate subrepresentatives. 
1 to: subreps size do: [:i | 
| subrep | 

subrep :- subreps at: i. 

(subrep isSpeciallyPassivatedObject or: [subrep parentCount == nil]) ifFalse: [ 
toDecrement value: subrep]]]]. 
[starts all: [:x | x = (treadmill size + 1 )]] assert." 

"Now make sure the algorithm at least produced a meaningful result." 
[treadmill all: [:x | x = (treadmill at: x index)]] assert." 

"Offset the indices now to be zero-relative, and we're done..." 
1 to: treadmill size do: [:i | 
|r| 

r := treadmill at: i. 
r index: r index - 1].! 



IPassivator methodsFor: 'private-writing'! 
writeClassDescription: class 

"Write a description of the class suitable for version verification. See whatlsFileFormat on the class side." 



| vars varString | 

self writeSizedString: class fullName. 
vars := class alllnstVarNames. 

varString ~ WriteStream on: (String new: 10 * vars size). 

vars do: [:var | varString nextPutAll: var; space]. 

self writelnt: class format. 

self writeSizedString: varString contents.! 



!Passivator methodsFor: 'private-passes'! 
writeClasses 

| array | 

array := Array new: classesToIndex size. 
classesToIndex keysAndValuesDo: [xlass :index | 

array at: index + 1 put: class], 
self writelnt: array size, 
array do: [xlass | 

self writeClassDescription: class].! 



JPassivator methodsFor: 'private-writing'! 
writelnt: int 

"Write the non-negative intt^mt to the stream. See whatlsFileFormat on the class side." 

| remainder | "Qt^ - 

remainder := int. \i^T" 
[remainder > 127] whileTrue: [ 

bytes at: (byteslndex := byteslndex + 1 ) put: (remainder bitAnd: 1 27) + 1 28. 

remainder := remainder bitShift: -7]. 
bytes at: (byteslndex := byteslndex + 1) put: remainder.! 
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!Passivator methodsFor: 'private-passes'! 
writeObjects 

| array | 

array := Array new: all Representatives size. 
1 to: all Representatives size do: [:i | 
|rep| 

rep :- allRepresentatives at: i. 
array at: rep index + 1 put: rep], 
self writelnt: array size. 

I to: array size do: [:i | (array at: i) writePartlFor: self). 
1 to: array size do: [:i | (array at: i) writePart2For: self]- 

self write ReferenceTo Representative: (self representative For: root), "indicate which object all this data represents." 



!Passivator methodsFor: 'private- writing'! 
writeRawBytes: bytesObject 

"Write the object's raw byte data to the stream." 

bytesObject class isBits ifFalse: [self error: 'Object must contain bytes'], 
bytes 

replaceBytesFrom: byteslndex + 1 

to: (byteslndex := byteslndex + bytesObject basicSize) 

with: bytesObject 

startingAt: 1.! 

writeReferenceToRepresentative: representativeOrSpecial 

"Write data representing a reference to the object in the representative." 

self writelnt: (representativeOrSpecial passivationlntegerEncodingln: self)! 
writeSizedString: aString 

"Write a string prefixed by its size." 

aString isString ifFalse: [self error: 'Must be a string'], 
self writelnt: aString size, 
self writeRawBytes: aString. ! 



Smalltalk defineClass: #ContinuousPassivator 
superclass: #{Passivatorj 
indexedType: #none 
private: false 
instance VariableNames: " 
classInstanceVariableNames: " 
imports: " 
category: "! 

!ContinuousPassivator class methodsFor: 'accessing'! 
headers tring 

"Answer the prefix used to identify this format." 

*'CP5iM 

t 
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!ContinuousPassivator methodsFor: 'private-converting'! 
convert: anObject 

"Answer a ByteArray representing the passivation of anObject." 

| firstClass result | 
classesToIndex isNil ifTrue: [ 

"Only initialize if this instance hasn't been used yet." 

classesToIndex := IdentityDictionary new]. 
firstClass := classesToIndex size. 

objectTo Representative := Passivation Large Identity Dictionary new. 

allRepresentatives := OrderedCollection new. 

root := anObject. 

self col lectObjects. 

self sortObjectsReverseBottomUp. 

self collectClasses. 

bytes isNil ifTrue: [bytes := PrivatePassivationByteArray new: (allRepresentatives size * 20 + 50)]. "guess size" 
byteslndex := 0. "used in a pre-increment way" 
self writeRawBytes: self class headerString. 
self writeClassesStartingAt: firstClass. 
self writeObjects. 

objectToRepresentative := root := stream := nil. "save some memory" 
result :- ByteArray new: byteslndex. 

result replaceBytesFrom: 1 to: byteslndex with: bytes startingAt: 1. 
Result! 

i 



! ContinuousPassivator methodsFor: 'private-passes'! 

writeClassesStartingAt: firstClass 

"The only difference between ContinuousPassivator and Passivator 
is that this method doesn't write out class definitions it has previously 
encoded. The count is still the same, but the initial N class definitions 
are simply omitted." 

| array | 

array := Array new: classesToIndex size. 
classesToIndex keysAndValuesDo: [xlass :index | 

array at: index + 1 put: class], 
self writelnt: array size. 
firstClass + 1 to: array size do: [:array Index | 

self writeClassDescription: (array at: arraylndex)].! 



Smalltalk defineClass: #MiosoftPassivator 
superclass: # {ContinuousPassivator} 
indexedType: #none 
private: false 

instanceVariableNames: " 
classlnstanceVariableNames: " 
imports: " 
category: "! 

!MiosoftPassivator class methodsFor: 'accessing'! 
headerString 

"Answer the prefix used toHdentify this format" 

A 'M* "M is for Miosoft"! -P&V 

! ■ ^ ■" 



IMiosoftPassivator methodsFor: 'private-representation'! 
preSavePassivate: anObject 

anObject oolsPersistent 

ifTrue: [ A anObject preSavePassivationForPersistentObject] 
i (False: [ A anObject preSavePassivation].! 
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Smalltalk. Applications defineClass: #MarshailingFramework 
superclass: #{ ENVY. Application} 
indexedType: #none 
private: false 

instance VariableNames: " 
classInstanceVariableNames: " 
imports: " 

category: 'ENVY/ManagerM. 



ICore. Behavior methodsFor: *:Passivation fixups'! 
isSpeciallyPassivatedObject 

A true! 

passivationlntegerEncodingln: aPassivator 

A (aPassivator indexOfClass: self) * 4 + 2! 



ICore.Character methodsFor: ': Passivation fixups'! 
isSpeciallyPassivatedObject 

A true! 

passivationlntegerEncodingln: aPassivator 
A se1faslnteger*4 + 12! 



! Kernel. CompiledCode methodsFor: ': Passivation passivation/activation'! 
preSavePassivation 

"I should not be passivated. Report an error if an attempt is made." 

self error: 'Should not passivate Compiled Code'.! 



! Core. False methodsFor: ':Passivation fixups*! 
isSpeciallyPassivatedObject 

A true! 

passivationlntegerEncodingln: aPassivator 
A 8! 



!Graphics.GraphicsHandle methodsFor: ':Passivation passivation/activation 
preSavePassivation 

"I should not be passivated. Report an error if an attempt is made." 

self error: 'Should not passivate GraphicsHandleM 

i 



! Core. Integer methodsFor: ': Passivation fixups*! 
isSpeciallyPassivatedObject 

A true! V-* 
passivationlntegerEncodingln: aPassivator 

A self<0 

ifTrue: [self* -8+1] 
itTalse: [self* 8 + 5]! 

i 
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! Core. Object class methods For: ': Passivation fixups'! 

activatorFixupForFormat: formatlnt instVars: FilelnstVars isVariable: isVariable isBits: isBits 
"Answer a block which, when evaluated at the right time with an instance 
of me and an Activator, will initialize the instance. Make sure to read the 
right amount of data from the activator." 

| image InstVars map | 

imagelnstVars := self alllnstVarNames. 

map :- filelnstVars collect: [:str | imagelnstVars indexOf: str ifAbsent: [nil]]. 

A [:object :activator | 

"Read and set the inst vars first..." 
map do: [:destlnstVar | 
I val| 

val := activator objectFromlndex: activator readlnt. 

destlnstVar notNil ifTrue: [object instVarAt: destlnstVar put: val]]. 
"Now check for variable / bits data..." 
isVariable ifTrue: [ 

isBits 

ifTrue: [activator readRawBytesInto: object] 
ifFalse: [ 

1 to: object basicSize do: [:i | 

object basic At: i put: (activator objectFromlndex: activator readlnt)]]]].! 



ICore.Object methodsFor: ':Passivation passivation/activation'! 
isSpeciallyPassivatedObject 

A false! 

passivationlntegerEncodingln: aPassivator 

self error: 'Must overide for specially passivated objects'.! 
postLoadActivation: anActivator 

"Activate myself now that I have been loaded by anActivator. Answer the object 
to substitute for myself in parent objects (when not involved in cycles). Subclasses 
should reimplement if there is a need to translate the object in some way during activation." 

A selfl 
preSavePassivation 

"Answer an object to passivate in place of myself. Subclasses should reimplement 
if there is a need to translate the object in some way during passivation." 

A self! 

preSavePassivationForPersistentObject 

"Answer an object to passivate in place of myself. Since I must be a persistent object, passivate 
a special oid-like object in place of me." 

self oolsPersistent ifFalse: [self error: This object must be persistent']. 
A PassivatedPersistentObjectReference new oid: self oid! 



!OoStub methodsFor: 'passivation'! 
preSavePassivationForPersistentObject 

"Answer an object to passiyate in place of myself. Since I must be a persistent object, passivate 

a special oid-like object in^^e^f me." 

A PassivatedPeraistentObj tt^^fctjii cc new oid: self oid! 



!OoVArray methodsFor: 'passivation/activation*! 

preSavePassivationForPersistentObject 

"Answer an object to passivate in place of myself. Even though I'm persistent, I don't have an oid of 
my own (that's just how the Objectivity/DB works). Passivate a transient copy of me instead." 

self oolsPersistent ifFalse: [self error: This object must be persistent']. 
A self copy! 

i 
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ICore.Set methodsFor: ': Passivation passivation/activation'! 

postLoadActivation: anActivator 

"Activate myself now that I have been loaded by anActivator. Answer the object 
to substitute for myself, which is simply myself after rehashing my elements." 



8 £ST AVAILABLE COP> 



self rehash. 
A self! 

t 



ICore.Smalllnteger methodsFor: ':Passivation fixups'! 
passivationlntegerEncodingln: aPassivator 



A self<0 

ifTrue: [self* -8+1] 
ifFaise: [self* 8 + 5]» 



ICore.Symbol methodsFor: ':Passivation passivation/activation 1 ! 

postLoadActivation: anActivator 

"Activate myself now that I have been loaded by anActivator. Answer the object 
to substitute for myself, which in this case is the interned version of me." 

A self class intern: self! 

i 



ICore.True methodsFor: ': Passivation fixups'! 
isSpeciallyPassivatedObject 

A true! 

passivationlntegerEncodingln: aPassivator 



A 4! 



!Core.UndefinedObject methodsFor: ':Passivation fixups'! 
isSpeciallyPassivatedObject 

A true! 

passivationlntegerEncodingln: aPassivator 
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